Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: C, VB.NET: Tiedonsiirto ohjelmien välillä

Sivun loppuun

vp [13.05.2008 13:08:12]

#

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?

Sami [13.05.2008 15:35:38]

#

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();
		}
	}
}

Meitzi [15.05.2008 22:02:32]

#

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.

latesoft [16.05.2008 11:54:24]

#

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.

User137 [17.05.2008 02:21:23]

#

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.

neau33 [17.05.2008 02:30:06]

#

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ä...

neau33 [10.06.2008 12:43:13]

#

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

Merri [10.06.2008 14:11:53]

#

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ä.

neau33 [11.06.2008 18:13:37]

#

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

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta