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 SubTä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 SubVB.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 SubSitten 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 ModuleAihe on jo aika vanha, joten et voi enää vastata siihen.