Terve!
Minulla on kaksi ohjelmaa toinen tehty VB6:lla ja toinen VB.net:lla. Näiden ohjelmien välillä pitäisi siirtää dataa kohtalaisen nopealla tahdilla. Löytyykö mitään kätevää rajapinta systeemiä homman toteuttamiseen?
Yksi toimiva siirtotapa on ohjata ohjelman A tuloste ohjelman B syötteeksi ja lukea ohjelman B antamaa tulostetta ohjelmalla A.
Esimerkki javalla (toivottavasti saat sovellettua sitä jollakin tapaa):
Ohjelma A ajaa ensin komentorivin ja antaa sille syötettä (komennot dir, time /T ja exit) ja tulostaa mitä komentoriville tulostui. Sen jälkeen A suorittaa ohjelman B ja antaa sille syötteeksi samat mitä komentorivillekin.
Ohjelma B kääntää syötetyt rivit käänteiseksi ja tulostaa ne.
//A.java: import java.io.IOException; import java.io.InputStream; import java.io.OutputStreamWriter; public class A { public static void main(String[] args) { // komentorivin ajoa: try { Process p = Runtime.getRuntime().exec("cmd"); OutputStreamWriter pOut = new OutputStreamWriter(p.getOutputStream()); pOut.write("dir\r\n"); pOut.write("time /T\r\n"); pOut.write("exit\r\n"); pOut.flush(); InputStream pIn = p.getInputStream(); int c; while ((c = pIn.read()) != -1) { System.out.print((char)c); } } catch (IOException e) { e.printStackTrace(); } // Tai toisen (java-)ohjelman ajoa: try { Process p = Runtime.getRuntime().exec("java B"); OutputStreamWriter pOut = new OutputStreamWriter(p.getOutputStream()); pOut.write("dir\r\n"); pOut.write("time /T\r\n"); pOut.write("exit\r\n"); pOut.flush(); pOut.close(); InputStream pIn = p.getInputStream(); int c; while ((c = pIn.read()) != -1) { System.out.print((char)c); } } catch (IOException e) { e.printStackTrace(); } } }
//B.java import java.io.BufferedReader; import java.io.IOException; import java.io.InputStreamReader; public class B { public static void main(String[] args) { try { String line; BufferedReader in = new BufferedReader(new InputStreamReader(System.in)); while ((line = in.readLine()) != null) { System.out.println(new StringBuilder(line).reverse().toString()); } } catch (IOException e) { e.printStackTrace(); } } }
Ekai TCP/IP ihan mahdottoman vaikea ole tehdä. Sitten on tietysti Microsoftin DCOM joka on nimenomaan tuohon tarkoitukseen tehty. Tosin sitä ei ole tainnut kukaan helpoksi kehua.
Minä löysin ratkaisun vastaavaan ongelmaan "Named Pipe" - järjestelyistä. Niissä voit siirtää max. 65kb tietoa yhdessä purskeessa vastaanottajalle ByteArray muodossa. Yksinkertaistettuna se jakaa tietyn osion välimuistista, eli pitäisi olla melko nopea menetelmä. Unohda heti kättelyssä kaikki ikkunakutsuista hakkeroidut tavat joita netti on pullollaan, niistä tulee vain harmaita hiuksia.
Joudut jokatapauksessa, ellei input tyylinen viritelmä toimi, perehtymään VB:n ulkopuoliseen ympäristöön. Microsoftilta löytyy jonkin verran valmiita listauksia ja muitakin sivustoja löytyy. Aihealue on vissiinkin senverran expert tasoa, että tietosuonet ovat lyhyitä ja harvassa. Mitään copy & paste tavaraa en itse ainakaan löytänyt monien päivien etsintöjen jälkeen.
Perusongelmahan näissä on se, että kaksi irrallista ohjelmaa ovat epäsynkronoituja (omissa säikeissään ja muistialueillaan), eli joko niiden välinen suhde lukitaan tyyliin suoritat kirjaston pääohjelmasta käsin, tai sitten sukellat kernelin muistinhallinnan syövereihin.
Vastaan tulee heti se, että VB6 ja VB.Net arkkitehtuurit ovat muuttuneet paljon ja ylivoimaisesti suurin osa koodilistauksista on VB6:lle. Joudut mm. perehtymään Delegate - komentoihin. Tie tulee olemaan kivinen.
Luulis VB:llekin löytyvän helppo tapa TCP/IP:n käyttöön. Delphillä onnistuu ainakin ihan lataamalla siihen sopiva komponentti ja heittämällä sen formille, paketin määrittely ja pari funktiokutsua.
Hostiksi localhost ja portiksi mikä vaan.
Moikka vp!
yksinkertaistettu malli...
'VB6 App Private Sub Form_Activate() MainLuuppi End Sub Sub MainLuuppi() Dim clptxt As String Do: DoEvents On Error Resume Next clptxt = Clipboard.GetText If Err <> 0 Then Err.Clear: On Error GoTo 0 End If If InStr(clptxt, "FROM My .NET App ") > 0 Then Text2.Text = Replace(clptxt, "FROM My .NET App ", "") On Error Resume Next Clipboard.Clear If Err <> 0 Then Err.Clear: On Error GoTo 0 End If End If Loop End Sub Private Sub Command1_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Or KeyCode = 32 Then SendData Text1 End Sub Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) SendData Text1 End Sub Sub SendData(Ctl As Control) If Ctl.Text <> "" Then On Error Resume Next Clipboard.Clear Clipboard.SetText "FROM My VB6 App " & Ctl.Text If Err <> 0 Then Err.Clear: On Error GoTo 0 End If End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) End End Sub
'.NET App Imports Microsoft.VisualBasic Imports Microsoft.VisualBasic.MyServices '... Sub MainFormShown(sender As Object, e As EventArgs) MainLuuppi End Sub Sub Mainluuppi() Dim txtclp As String Do: Application.DoEvents Try If My.Computer.Clipboard.ContainsText Then Try txtclp = My.Computer.Clipboard.GetText() If txtclp.IndexOf ("FROM My VB6 App ") > -1 Then TextBox2.Text = Replace(txtclp, "FROM My VB6 App ", "") Try My.Computer.Clipboard.Clear Catch ex3 As Exception End Try End If Catch ex2 As Exception End Try End If Catch ex As Exception End Try Loop End Sub Sub Button1MouseUp(sender As Object, e As MouseEventArgs) SendData(TextBox1) End Sub Sub Button1KeyUp(sender As Object, e As KeyEventArgs) If e.KeyCode = 13 Or e.KeyCode = 32 Then messagebox.Show("jee") End If End Sub Sub MainFormFormClosed(sender As Object, e As FormClosedEventArgs) End End Sub Sub SendData(Ctl As Control) If Ctl.Text <> "" Then Try My.Computer.Clipboard.Clear My.Computer.Clipboard.SetText("FROM My .NET App " + Ctl.Text) Catch ex As Exception End Try End If End Sub
Tämä ei ole missään nimessä mikään hyvä ratkaisu, koska muutkin avoimet sovellukset voivat käyttä leikepöytää samaan aikaan...lähettämistä voisi tietysti hieman "synkronoida" Timerillä...
Huomattavasti parempi vaihtoehto on pukata data sarja-porttiin ja lukea se portista...edelleen on mahdollista luoda virtuaaliportti kirjoitelua/lukua varten, mutta tähän vaaditaan jo hieman tietämystä...
Heippa taas!
tässä vielä yksi tapa vaihtaa dataa eri sovellusten välillä
(tiedonsiirto toimii kaikkien sovellusten välillä, jotka kykenevät lukemaan/kirjoittamaan tekstitiedostoja)
systeemi käyttää hyväkseen RAM-levyä, jotenka jos käyttis on esim. XP niin tätä kautta löydät ohjeet RAM-driverin asentamiseen
VB6-sovellus
Private Sub Form_Load() Timer1.Interval = 500 Timer1.Enabled = True End Sub Private Sub Command1_Click() If Text1.Text = "" Then Exit Sub On Error Resume Next Open "z:\vb6.dat" For Output As #1 Print #1, Text1.Text: Close #1 If Err <> 0 Then Err.Clear: On Error GoTo 0 End If End Sub Private Sub Timer1_Timer() DoEvents If Dir("z:\vbnet.dat") <> "" Then On Error Resume Next Open "z:\vbnet.dat" For Input As #1 Text2.Text = Input$(LOF(1), 1): Close #1 Kill "z:\vbnet.dat" If Err <> 0 Then Err.Clear: On Error GoTo 0 End If End If End Sub
VB.NET-sovellus
Sub MainFormLoad(sender As Object, e As EventArgs) timer1.Interval = 500 timer1.Enabled = True End Sub Sub Button1Click(sender As Object, e As EventArgs) If textBox1.Text = "" Then Exit Sub End If Try FileSystem.FileOpen (1,"z:\vbnet.dat", OpenMode.Output) FileSystem.Print(1,textbox1.Text) FileSystem.FileClose(1) Catch ex as Exception End Try End Sub Sub Timer1Tick(sender As Object, e As EventArgs) Application.DoEvents If Filesystem.Dir("z:\vb6.dat") <> "" Then Try FileSystem.FileOpen (1,"z:\vb6.dat", OpenMode.Input) FileSystem.Input(1, textbox2.Text) FileSystem.FileClose(1) FileSystem.Kill("z:\vb6.dat") Catch ex As Exception End Try End If End Sub
Sitten on myös olemassa DDE, joka on nimenomaan suunniteltu ohjelmien väliseen kommunikaatioon. Sen .NET-puolesta en tiedä mitään, mutta tässä on VB6-esimerkki, jossa käytetään DDE:tä puhtaasti API:n voimalla:
http://www.thescarms.com/vbasic/ddeml.aspx
Sillä voi komentaa esim. Firefoxin avaamaan osoitteen, hyvin toimii kunhan Firefox on käynnissä.
Heippa taas!
Koskapa VB.NET ei sisällä natiivia tukea DDE:lle niin jutskat on hoidettava API-purkalla. DDE-servun tai clientin toteuttaminen .NET ympäristössä ei ole ehkä aivan kaikkein yksinkertaisimpia viritelmiä, mutta tässä valmis VB.NET/API-moduuli niille joita viritelmät kiinnostavat...
Option Strict On Option Explicit On Option Compare Binary Imports System.Runtime.InteropServices.LayoutKind Imports System.Runtime.InteropServices.Marshal Imports System.Windows.Forms.DataFormats Friend Module DDE Friend Enum WM_DDE As Integer FIRST = &H3E0 INITIATE = FIRST TERMINATE ADVISE UNADVISE ACK DATA REQUEST POKE EXECUTE LAST = EXECUTE End Enum Public Function IsDDEMsg(ByVal Msg As Integer) As Boolean Return (Msg And Not &HF) = WM_DDE.FIRST End Function <System.Runtime.InteropServices.StructLayout(Sequential)> _ Private Structure DDEACKPREFIX Private Flags As Short <System.Flags()> Private Enum PREFIXFlags As Short AckCodeMask = &HFFS Response = &H1000S Release = &H2000S DeferUpd = &H4000S AckReq = &H8000S End Enum Private Property fFlag(ByVal prefixFlag As PREFIXFlags) As Boolean Get Return (Flags And prefixFlag) <> 0S End Get Set(ByVal Value As Boolean) If Value Then Flags = (Flags Or prefixFlag) Else Flags = (Flags And Not prefixFlag) End If End Set End Property Public Property fResponse() As Boolean Get Return (fFlag(PREFIXFlags.Response)) End Get Set(ByVal Value As Boolean) fFlag(PREFIXFlags.Response) = Value End Set End Property Public Property fRelease() As Boolean Get Return fFlag(PREFIXFlags.Release) End Get Set(ByVal Value As Boolean) fFlag(PREFIXFlags.Release) = Value End Set End Property Public Property fDeferUpd() As Boolean Get Return fFlag(PREFIXFlags.DeferUpd) End Get Set(ByVal Value As Boolean) fFlag(PREFIXFlags.DeferUpd) = Value End Set End Property Public Property fAckReq() As Boolean Get Return fFlag(PREFIXFlags.AckReq) End Get Set(ByVal Value As Boolean) fFlag(PREFIXFlags.AckReq) = Value End Set End Property Public Property bAppReturnCode() As Byte Get Return CByte(Flags And PREFIXFlags.AckCodeMask) End Get Set(ByVal Value As Byte) Flags = (CShort(Value) And PREFIXFlags.AckCodeMask) _ Or (Flags And Not PREFIXFlags.AckCodeMask) End Set End Property End Structure <System.Runtime.InteropServices.StructLayout(Sequential)> _ Public Structure DDEACK Private Prefix As DDEACKPREFIX Public Property fBusy() As Boolean Get Return Prefix.fDeferUpd End Get Set(ByVal Value As Boolean) Prefix.fDeferUpd = Value End Set End Property Public Property fAck() As Boolean Get Return Prefix.fAckReq End Get Set(ByVal Value As Boolean) Prefix.fAckReq = Value End Set End Property Public Property bAppReturnCode() As Byte Get Return Prefix.bAppReturnCode End Get Set(ByVal Value As Byte) Prefix.bAppReturnCode = Value End Set End Property End Structure <System.Runtime.InteropServices.StructLayout(Sequential)> _ Private Structure DDEDATAPREFIX Public Flags As DDEACKPREFIX Private Format As Short Public Property cfFormat() As Format Get Return GetFormat(Format) End Get Set(ByVal Value As Format) Format = CShort(Value.Id) End Set End Property End Structure <System.Runtime.InteropServices.StructLayout(Sequential)> _ Public Structure DDEADVISE Private Prefix As DDEDATAPREFIX Public Property fDeferUpd() As Boolean Get Return Prefix.Flags.fDeferUpd End Get Set(ByVal Value As Boolean) Prefix.Flags.fDeferUpd = Value End Set End Property Public Property fAckReq() As Boolean Get Return Prefix.Flags.fAckReq End Get Set(ByVal Value As Boolean) Prefix.Flags.fAckReq = Value End Set End Property Public Property cfFormat() As Format Get Return Prefix.cfFormat End Get Set(ByVal Value As Format) Prefix.cfFormat = Value End Set End Property End Structure <System.Runtime.InteropServices.StructLayout(Sequential)> _ Public Structure DDEDATA Private Prefix As DDEDATAPREFIX Public Property fResponse() As Boolean Get Return Prefix.Flags.fResponse End Get Set(ByVal Value As Boolean) Prefix.Flags.fResponse = Value End Set End Property Public Property fRelease() As Boolean Get Return Prefix.Flags.fRelease End Get Set(ByVal Value As Boolean) Prefix.Flags.fRelease = Value End Set End Property Public Property fAckReq() As Boolean Get Return Prefix.Flags.fAckReq End Get Set(ByVal Value As Boolean) Prefix.Flags.fAckReq = Value End Set End Property Public Property cfFormat() As Format Get Return Prefix.cfFormat End Get Set(ByVal Value As Format) Prefix.cfFormat = Value End Set End Property End Structure <System.Runtime.InteropServices.StructLayout(Sequential)> _ Public Structure DDEPOKE Private Prefix As DDEDATAPREFIX Public Property fRelease() As Boolean Get Return Prefix.Flags.fRelease End Get Set(ByVal Value As Boolean) Prefix.Flags.fRelease = Value End Set End Property Public Property cfFormat() As Format Get Return Prefix.cfFormat End Get Set(ByVal Value As Format) Prefix.cfFormat = Value End Set End Property End Structure Friend Declare Function GlobalLock Lib "Kernel32" ( _ ByVal hMem As System.IntPtr) As System.IntPtr Friend Declare Function GlobalUnlock Lib "Kernel32" ( _ ByVal hMem As System.IntPtr) As System.IntPtr Friend Declare Function UnpackDDElParam Lib "User32" ( _ ByVal msg As Integer, ByVal lParam As System.IntPtr, _ ByRef LowWord As Short, ByRef HighWord As Short) As Integer Friend Declare Function UnpackDDElParam Lib "User32" ( _ ByVal msg As Integer, ByVal lParam As System.IntPtr, _ ByRef LowWord As System.IntPtr, ByRef HighWord As Short) As Integer Friend Declare Function PackDDElParam Lib "User32" ( _ ByVal msg As Integer, ByVal LowWord As Short, _ ByVal HighWord As Short) As Integer Friend Declare Function PackDDElParam Lib "User32" ( _ ByVal msg As Integer, ByVal LowWord As System.IntPtr, _ ByVal HighWord As Short) As Integer Friend Declare Function PackDDElParam Lib "User32" ( _ ByVal msg As Integer, ByVal LowWord As System.IntPtr, _ ByVal HighWord As System.IntPtr) As Integer Friend Declare Function FreeDDElParam Lib "User32" ( _ ByVal msg As Integer, ByVal lParam As System.IntPtr) As Integer Public ReadOnly BROADCAST As System.IntPtr = New System.IntPtr(-1) Friend Declare Ansi Function SendMessage Lib _ "User32" Alias "SendMessageA" (ByVal hWnd As System.IntPtr, _ ByVal Msg As Integer, ByVal wParam As System.IntPtr, _ ByVal lParam As Integer) As Integer Friend Declare Ansi Function PostMessage Lib _ "User32" Alias "PostMessageA" (ByVal hWnd As System.IntPtr, _ ByVal Msg As Integer, ByVal wParam As System.IntPtr, _ ByVal lParam As Integer) As Integer Friend Declare Auto Function InSendMessage Lib _ "User32" Alias "InSendMessage" () As Boolean Friend Declare Auto Function IsWindowUnicode Lib _ "User32" Alias "IsWindowUnicode" ( _ ByVal hWnd As System.IntPtr) As Boolean Friend Declare Ansi Function GlobalAddAtom Lib _ "Kernel32" Alias "GlobalAddAtomA" (ByVal Buffer As String) As Short Friend Declare Ansi Function GlobalGetAtomName Lib _ "Kernel32" Alias "GlobalGetAtomNameA" (ByVal Atom As Short, _ ByVal Buffer As String, ByVal BufferLen As Integer) As Integer Friend Declare Auto Function GlobalDeleteAtom Lib _ "Kernel32" Alias "GlobalDeleteAtom" (ByVal Atom As Short) As Short End Module Friend Class DDEmessageFilter Implements System.Windows.Forms.IMessageFilter Public hWnd As System.IntPtr Public Enum ACKTYPES OK Busy NACK End Enum Public Event Initiate(ByVal hWnd As System.IntPtr, _ ByVal App As String, ByVal Topic As String) Public Event InitACK(ByVal hWnd As System.IntPtr, _ ByVal App As String, ByVal Topic As String) Public Event Terminate(ByVal hWnd As System.IntPtr) Public Event Advise(ByVal hWnd As System.IntPtr, _ ByVal Item As String, ByVal TransportAdvice As DDEADVISE) Public Event UnAdvise(ByVal hWnd As System.IntPtr, _ ByVal Item As String, ByVal Format As Format) Public Event ACK(ByVal hWnd As System.IntPtr, _ ByVal Item As String, ByVal Response As ACKTYPES, _ ByVal AppReturnCode As Byte) Public Event Data(ByVal hWnd As System.IntPtr, _ ByVal Item As String, ByVal DataInfo As DDEDATA, _ ByVal DataPtr As System.IntPtr) Public Event Request(ByVal hWnd As System.IntPtr, _ ByVal Item As String, ByVal Format As Format) Public Event Poke(ByVal hWnd As System.IntPtr, _ ByVal Item As String, ByVal PokeInfo As DDEPOKE, _ ByVal PokePtr As System.IntPtr) Public Event Execute(ByVal hWnd As System.IntPtr, _ ByVal Command As String, ByVal hCommand As System.IntPtr) Private Function GetAtomString(ByVal Atom As Short) As String If Atom = 0 Then Return Nothing End If Dim BufferLen As Integer Dim Buffer As String BufferLen = 514 Buffer = New String(Microsoft.VisualBasic.ChrW(0), BufferLen) BufferLen = GlobalGetAtomName(Atom, Buffer, BufferLen) If BufferLen = 0 Then System.Diagnostics.Trace.WriteLine( _ "GetAtomString failed with DLL error number " _ & Microsoft.VisualBasic.Err.LastDllError()) Return Nothing Else Return Buffer.Substring(0, BufferLen) End If End Function Protected Overridable Function OnInitiate( _ ByRef m As System.Windows.Forms.Message) As Boolean Dim AppAtom As Short Dim App As String Dim TopicAtom As Short Dim Topic As String UnpackDDElParam(m.Msg, m.LParam, AppAtom, TopicAtom) Topic = GetAtomString(TopicAtom) App = GetAtomString(AppAtom) RaiseEvent Initiate(m.WParam, App, Topic) FreeDDElParam(m.Msg, m.LParam) Return True End Function Protected Overridable Function OnTerminate( _ ByRef m As System.Windows.Forms.Message) As Boolean RaiseEvent Terminate(m.WParam) FreeDDElParam(m.Msg, m.LParam) Return True End Function Protected Overridable Function OnAdvise( _ ByRef m As System.Windows.Forms.Message) As Boolean Dim TransportAdvice As DDEADVISE Dim ItemAtom As Short Dim Item As String Dim hMem As System.IntPtr UnpackDDElParam(m.Msg, m.LParam, hMem, ItemAtom) Item = GetAtomString(ItemAtom) TransportAdvice = CType(PtrToStructure( _ GlobalLock(hMem), TransportAdvice.GetType()), DDEADVISE) RaiseEvent Advise(m.WParam, Item, TransportAdvice) GlobalUnlock(hMem) FreeDDElParam(m.Msg, m.LParam) Return True End Function Protected Overridable Function OnUnAdvise( _ ByRef m As System.Windows.Forms.Message) As Boolean Dim Format As Format Dim FormatID As Short Dim ItemAtom As Short Dim Item As String UnpackDDElParam(m.Msg, m.LParam, FormatID, ItemAtom) Format = GetFormat(FormatID) Item = GetAtomString(ItemAtom) RaiseEvent UnAdvise(m.WParam, Item, Format) FreeDDElParam(m.Msg, m.LParam) Return True End Function Protected Overridable Function OnAck( _ ByRef m As System.Windows.Forms.Message) As Boolean If InSendMessage Then Dim AppAtom As Short Dim App As String Dim TopicAtom As Short Dim Topic As String SplitInt(m.LParam.ToInt32, AppAtom, TopicAtom) Topic = GetAtomString(TopicAtom) App = GetAtomString(AppAtom) RaiseEvent InitACK(m.WParam, App, Topic) Else Dim ItemAtom As Short Dim Item As String Dim AckData As DDEACK Dim hMem As System.IntPtr UnpackDDElParam(m.Msg, m.LParam, hMem, ItemAtom) Item = GetAtomString(ItemAtom) AckData = CType(PtrToStructure(GlobalLock(hMem), _ AckData.GetType), DDEACK) Dim AckType As ACKTYPES = ACKTYPES.NACK If AckData.fAck Then AckType = ACKTYPES.OK ElseIf AckData.fBusy Then AckType = ACKTYPES.Busy End If RaiseEvent ACK(m.WParam, Item, AckType, AckData.bAppReturnCode) GlobalUnlock(hMem) GlobalDeleteAtom(ItemAtom) FreeDDElParam(m.Msg, m.LParam) End If Return True End Function Protected Overridable Function OnData( _ ByRef m As System.Windows.Forms.Message) As Boolean Dim ItemAtom As Short Dim Item As String Dim hDDEData As System.IntPtr Dim pDDEData As System.IntPtr Dim DDEData As DDEData Dim FreeData As Boolean Try UnpackDDElParam(m.Msg, m.LParam, hDDEData, ItemAtom) Item = GetAtomString(ItemAtom) pDDEData = GlobalLock(hDDEData) DDEData = CType(PtrToStructure(pDDEData, _ DDEData.GetType()), DDEData) FreeData = DDEData.fRelease RaiseEvent Data(m.WParam, Item, DDEData, IncPtr( _ pDDEData, SizeOf(DDEData))) Finally GlobalUnlock(hDDEData) If FreeData Then FreeHGlobal(hDDEData) End If FreeDDElParam(m.Msg, m.LParam) End Try Return True End Function Protected Overridable Function OnRequest( _ ByRef m As System.Windows.Forms.Message) As Boolean Dim Format As Format Dim FormatID As Short Dim ItemAtom As Short Dim Item As String UnpackDDElParam(m.Msg, m.LParam, FormatID, ItemAtom) Format = GetFormat(FormatID) Item = GetAtomString(ItemAtom) RaiseEvent Request(m.WParam, Item, Format) FreeDDElParam(m.Msg, m.LParam) Return True End Function Protected Overridable Function OnPoke( _ ByRef m As System.Windows.Forms.Message) As Boolean Dim DDEPoke As DDEPOKE Dim ItemAtom As Short Dim Item As String Dim hDDEPoke As System.IntPtr Dim pDDEPoke As System.IntPtr UnpackDDElParam(m.Msg, m.LParam, hDDEPoke, ItemAtom) Item = GetAtomString(ItemAtom) pDDEPoke = GlobalLock(hDDEPoke) PtrToStructure(pDDEPoke, DDEPoke) RaiseEvent Poke(m.WParam, Item, DDEPoke, _ IncPtr(pDDEPoke, SizeOf(DDEPoke))) GlobalUnlock(hDDEPoke) FreeDDElParam(m.Msg, m.LParam) Return True End Function Protected Overridable Function OnExecute( _ ByRef m As System.Windows.Forms.Message) As Boolean Dim Exec As String If IsWindowUnicode(m.HWnd) AndAlso IsWindowUnicode(m.WParam) Then Exec = PtrToStringUni(GlobalLock(m.LParam)) Else Exec = PtrToStringAnsi(GlobalLock(m.LParam)) End If RaiseEvent Execute(m.WParam, Exec, m.LParam) GlobalUnlock(m.LParam) FreeDDElParam(m.Msg, m.LParam) Return True End Function Public Function PreFilterMessage( _ ByRef m As System.Windows.Forms.Message) As Boolean _ Implements System.Windows.Forms.IMessageFilter.PreFilterMessage Dim Broadcast As Boolean = (Broadcast.Equals(m.HWnd)) If (Broadcast OrElse m.HWnd.Equals(hWnd)) _ AndAlso IsDDEMsg(m.Msg) Then Select Case m.Msg Case WM_DDE.INITIATE Return OnInitiate(m) Case WM_DDE.TERMINATE Return OnTerminate(m) Case WM_DDE.ADVISE Return OnAdvise(m) Case WM_DDE.UNADVISE Return OnUnAdvise(m) Case WM_DDE.ACK Return OnAck(m) Case WM_DDE.DATA Return OnData(m) Case WM_DDE.REQUEST Return OnRequest(m) Case WM_DDE.POKE Return OnPoke(m) Case WM_DDE.EXECUTE Return OnExecute(m) Case Else Return False End Select Return True Else Return False End If End Function Public Sub New(ByVal hWnd As System.IntPtr) MyBase.New() Me.hWnd = hWnd End Sub End Class Friend Module Utils <System.Runtime.InteropServices.StructLayout(Explicit)> _ Private Structure CvtLong <System.Runtime.InteropServices.FieldOffset(0)> _ Public LongValue As Integer <System.Runtime.InteropServices.FieldOffset(0)> _ Public LoWord As Short <System.Runtime.InteropServices.FieldOffset(2)> _ Public HiWord As Short End Structure Public Function MakeInt(ByVal LoWord As Short, _ ByVal HiWord As Short) As Integer Dim Convert As CvtLong Convert.HiWord = HiWord Convert.LoWord = LoWord Return Convert.LongValue End Function Public Sub SplitInt(ByVal Value As Integer, _ ByRef LoWord As Short, ByRef HiWord As Short) Dim Convert As CvtLong Convert.LongValue = Value HiWord = Convert.HiWord LoWord = Convert.LoWord End Sub Public Function IncPtr(ByVal Ptr As System.IntPtr, _ ByVal Offset As Integer) As System.IntPtr Return New System.IntPtr(Ptr.ToInt32 + Offset) End Function End Module
Aihe on jo aika vanha, joten et voi enää vastata siihen.