... bin nach einer kurzen Pause wieder am Thema dran ...
Hallo Günter,Günter Beyes hat geschrieben:Ausserdem müsste man mal schauen, ob VBScript Funktionen hat, die chr(), Bin2U() und U2Bin() entsprechen. Wenn nein, müsste Phils Übertragungsformat entsprechend geändert werden, dass es passt.
die Funktionen Bin2U() / U2Bin() scheinen hierbei der Knackpunkt zu sein.
Ich habe es bisher hinbekommen ein VBScript zu basteln welches das Xbase-Programm NPServer.exe aufruft.
Der Aufruf klappt - das Erzeugen der Pipelines im VBScript auch.
Die NPServer.exe akzeptiert die Pipes und meldet "verbunden".
Bis hierher komme ich - weiter leider nicht.
Die Funktionen Bin2U() und U2Bin() habe ich im VBScript nachgebildet (mit Hilfe des Internets).
Die Übergabe von Werten über die Pipeline (VBS nach Xbase) klappt "noch"
nicht.Es scheint so, als würde es an den o.g. Funktionen liegen. Leider habe ich bis dato noch keine Ahnung wo ich was ändern sollte. (Übertragungsprotokoll
)Hier mal das Script:
Code: Alles auswählen
' VB Script Document
Public Function Dez2Bin(Wert)
Dim BinWert, i, Summe, BinLaenge, DezWert, ZWSumme
BinWert = 0
DezWert = Wert
i = 0
If Wert <> 0 Then
Do While DezWert >= BinWert
BinWert = 1*2^BinLaenge
BinLaenge = BinLaenge + 1
Loop
BinLaenge = BinLaenge -2
Summe = "1"
DezWert = DezWert - (1 * 2^BinLaenge)
BinLaenge = BinLaenge -1
For i = BinLaenge To 0 Step -1
If DezWert >= (1 * 2^i) Then
Summe = Summe & "1"
DezWert = DezWert - (1 * 2^i)
Else
Summe = Summe & "0"
End if
Next
If Wert < 0 Then
ZWSumme = Summe
For i = len(ZWSumme) to 1
If mid(ZWSumme,i,1) = 1 Then
Summe = Summe & "0"
Else
Summe = Summe & "1"
End if
Next
End If
'msgbox("Summe: " & Summe)
Dez2Bin = Summe
Else
Dez2Bin = 0
End if
End Function
'*******************************************************************************
Public Function Bin2Dez(Wert)
Dim Laenge, i, Summe
Laenge = len(Wert)-1
Summe = 0
If left(Wert,1) = "0" Then
else
For i = 0 to Laenge
Summe = Summe + mid(Wert,i+1,1)*(2^(Laenge-i))
Next
End if
Bin2Dez = Summe
End Function
Function CallServer( string, outpipe, inpipe )
Dim rc
Dim nLen
If IsNull(outpipe) = False Then
string = Chr(1) & Dez2Bin(Len(string)) & string
string = Dez2Bin(Len(String)) & string
outpipe.Write( String )
Else
Msgbox( "Function CallServer: " & "outpipe is null" )
End If
' If IsNull(inpipe) = False Then
' Wscript.Sleep(100)
' rc = inpipe.Read( 4 )
' rc = inpipe.Read( 1 )
' rc = inpipe.Read( 4 )
' nLen = Bin2Dez( rc )
' rc = inpipe.Read( nLen )
' ' Rückgabewert
' CallServer = rc
' Else
' Msgbox( "Function CallServer: " & "inpipe is null" )
' End If
End Function
'*******************************************************************************
Sub Start
Dim process
Dim fso
Dim out
Dim pin
Dim rc
Dim cCall
' Pipe-Server definieren
Set process = CreateObject("Wscript.Shell")
' Server starten
process.Run "C:\xyz\xyz\NPServer.exe"
' Initialisierung des Servers abwarten
Wscript.Sleep(1000)
'Define object for PIPES
Set fso = CreateObject("Scripting.FileSystemObject")
'Setup access to named pipes
Wscript.Sleep(500)
Set out = fso.CreateTextFile("\\.\pipe\out", 0)
Wscript.Sleep(500)
Set pin = fso.OpenTextFile("\\.\pipe\in", 1)
' Parameter übergeben ...
cCall = "4700+11"
rc = CallServer( cCall, out, pin )
Wscript.Sleep(1000)
cCall = "CLOSE_PIPE"
rc = CallServer( cCall, out, pin )
'msgbox("VOR ENDE")
'Close handles to the PIPES
out.Close
pin.Close
msgbox("ENDE")
End Sub
StartGruß,
Notloesung
.