Attribute VB_Name = "StartNettalk"
Option Explicit

Private Const VBServerName = "Nettalk"
Private Const VBTopicName = "MainWindow"
Private Const XCLASS_BOOL = &H1000
Private Const XTYPF_NOBLOCK = &H2
Private Const XTYP_CONNECT = &H60 Or XCLASS_BOOL Or XTYPF_NOBLOCK
Private Const CP_WINANSI = 1004
'Private Const CP_WINUNICODE = 1200
Private Const DDE_FACK = &H8000
Private Const XCLASS_FLAGS = &H4000
Private Const XTYP_EXECUTE = &H50 Or XCLASS_FLAGS
Private Const DNS_REGISTER = &H1
Private Const DNS_UNREGISTER = &H2
Private Const XTYP_POKE = (&H90 Or XCLASS_FLAGS)

Private Declare Function InitCommonControls Lib "comctl32.dll" () As Long

Private Declare Function DdeDisconnect Lib "user32" (ByVal hConv As Long) As Long
Private Declare Function DdeNameService Lib "user32" (ByVal idInst As Long, ByVal hsz1 As Long, ByVal hsz2 As Long, ByVal afCmd As Long) As Long
Private Declare Function DdeFreeStringHandle Lib "user32" (ByVal idInst As Long, ByVal hsz As Long) As Long
Private Declare Function DdeUninitialize Lib "user32" (ByVal idInst As Long) As Long
Private Declare Function DdeClientTransaction Lib "user32" (ByVal PData As Long, ByVal cbData As Long, ByVal hConv As Long, ByVal hszItem As Long, ByVal wFmt As Long, ByVal wType As Long, ByVal dwTimeout As Long, pdwResult As Long) As Long
Private Declare Function DdeCreateDataHandle Lib "user32" (ByVal idInst As Long, pSrc As Any, ByVal cb As Long, ByVal cbOff As Long, ByVal hszItem As Long, ByVal wFmt As Long, ByVal afCmd As Long) As Long
Private Declare Function DdeGetData Lib "user32" (ByVal hData As Long, pDst As Any, ByVal cbMax As Long, ByVal cbOff As Long) As Long
Private Declare Function DdeConnect Lib "user32" (ByVal idInst As Long, ByVal hszService As Long, ByVal hszTopic As Long, pCC As Long) As Long

Private Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" (pidInst As Long, ByVal pfnCallback As Long, ByVal afCmd As Long, ByVal ulRes As Long) As Integer
Private Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" (ByVal idInst As Long, ByVal psz As String, ByVal iCodePage As Long) As Long
Private Declare Function DdeQueryString Lib "user32" Alias "DdeQueryStringA" (ByVal idInst As Long, ByVal hsz As Long, ByVal psz As String, ByVal cchMax As Long, ByVal iCodePage As Long) As Long

Public LastCommandLine As String
Public NoRegEntry As Boolean

Private idInst As Long
Private hszVBServer As Long
Private hszVBTopic As Long

Public Sub ListenDDE()
  If DdeInitialize(idInst, AddressOf DdeCallback, 0, 0) Then Exit Sub
  hszVBServer = DdeCreateStringHandle(idInst, VBServerName, CP_WINANSI)
  hszVBTopic = DdeCreateStringHandle(idInst, VBTopicName, CP_WINANSI)
  DdeNameService idInst, hszVBServer, 0, DNS_REGISTER
End Sub

Public Function ExeDDEMessage(DDEServer As String, DDETopic As String, DDECommand As String, Optional ByVal DDETimeOut As Long = 1000) As Integer
  Dim ui As Long
  Dim idInst As Long
  Dim hConv As Long
  Dim hExecData As Long
  Dim I As Integer

  If LCase(VBServerName) = LCase(DDEServer) And hszVBServer > 0 Then Exit Function
  
  ui = DdeInitialize(idInst, AddressOf DdeCallback, 0, 0)
  If ui = 0 Then
    hszVBServer = DdeCreateStringHandle(idInst, DDEServer, CP_WINANSI)
    hszVBTopic = DdeCreateStringHandle(idInst, DDETopic, CP_WINANSI)

    hConv = DdeConnect(idInst, hszVBServer, hszVBTopic, 0)

    DdeFreeStringHandle idInst, hszVBServer
    DdeFreeStringHandle idInst, hszVBTopic

    If hConv Then
      hExecData = DdeCreateDataHandle(idInst, ByVal DDECommand, Len(DDECommand), 0, 0, 0, 0)
      If hExecData Then
        DdeClientTransaction hExecData, -1, hConv, 0, 0, XTYP_EXECUTE, DDETimeOut, 0
        ExeDDEMessage = 1
      End If
      DdeDisconnect hConv
    End If
    DdeUninitialize idInst
  End If
End Function

Public Function PokeDDEMessage(DDEServer As String, DDETopic As String, DDECommand As String, Optional ByVal DDETimeOut As Long = 1000) As Integer
  Dim ui As Long
  Dim idInst As Long
  Dim hConv As Long
  Dim hPokeData As Long
  Dim hSendStr As Long
  Dim I As Integer
  Dim ResultStr As Long
    
  If LCase(VBServerName) = LCase(DDEServer) And hszVBServer > 0 Then Exit Function
    
  ui = DdeInitialize(idInst, AddressOf DdeCallback, 0, 0)
  If ui = 0 Then
    hszVBServer = DdeCreateStringHandle(idInst, DDEServer, CP_WINANSI)
    hszVBTopic = DdeCreateStringHandle(idInst, DDETopic, CP_WINANSI)
    
    hConv = DdeConnect(idInst, hszVBServer, hszVBTopic, 0)
    
    DdeFreeStringHandle idInst, hszVBServer
    DdeFreeStringHandle idInst, hszVBTopic
    
    If hConv Then
      If Len(DDECommand) Then
        hSendStr = DdeCreateStringHandle(idInst, DDECommand, CP_WINANSI)
      Else
        hSendStr = DdeCreateStringHandle(idInst, " ", CP_WINANSI)
      End If
      
      hPokeData = DdeCreateDataHandle(idInst, ByVal DDECommand, Len(DDECommand) + 1, 0, hSendStr, CP_WINANSI, 0)
      If hPokeData Then
        DdeClientTransaction hPokeData, -1, hConv, hSendStr, CP_WINANSI, XTYP_POKE, DDETimeOut, 0
        PokeDDEMessage = 1
      End If
      
      DdeFreeStringHandle idInst, hSendStr
      DdeDisconnect hConv
    End If
    DdeUninitialize idInst
  End If
End Function

Private Function DdeCallback(ByVal uType As Long, ByVal uFmt As Long, ByVal hConv As Long, ByVal hszTopic As Long, ByVal hszItem As Long, ByVal hData As Long, ByVal dwData1 As Long, ByVal dwData2 As Long) As Long
  Dim ICount As Long
  Dim Buffers As String
  Dim TopicBuffer As String
  Dim I As Integer
    
  Select Case uType
    Case XTYP_CONNECT
      DdeCallback = DDE_FACK
    Case XTYP_EXECUTE, XTYP_POKE
      ICount = DdeQueryString(idInst, hszTopic, vbNullString, 0, CP_WINANSI)
      TopicBuffer = Space(ICount)
      DdeQueryString idInst, hszTopic, TopicBuffer, ICount + 1, CP_WINANSI

      ICount = DdeGetData(hData, ByVal vbNullString, 0, 0&)
      Buffers = Space(ICount)
      DdeGetData hData, ByVal Buffers, ICount + 1, 0&
      I = InStr(1, Buffers, Chr(0))
      If I > 0 Then Buffers = Left(Buffers, I - 1)
      If ntScript_Call("RecvDDECmd", Buffers, TopicBuffer) Then
        If VBTopicName = TopicBuffer Then Form1.DataPort.Text = Buffers
      End If
      DdeCallback = DDE_FACK
  End Select
End Function

Public Sub UnloadDDE()
  If hszVBServer Then
    DdeFreeStringHandle idInst, hszVBServer
    DdeFreeStringHandle idInst, hszVBTopic
    DdeNameService idInst, hszVBServer, 0, DNS_UNREGISTER
    DdeUninitialize idInst
  End If
End Sub

Private Sub Main()
  Dim DAT As String
  Dim WindowID As Long
  Dim hProcessID As Long
  Dim I As Integer
  Dim Frif As Integer
  
  On Error Resume Next
  InitCommonControls
  On Error GoTo 0
   
  IsNt = getVersion >= 2000 'Is Windows NT
  IsAfterVista = getVersion >= 2061 'Windows7 or newer
  
  If LCase(Command) = "debugmode" Then
    LastCommandLine = ""
  Else
    LastCommandLine = Right(GetCommandline, Len(Command))
  End If
 
  If App.PrevInstance = True And LastCommandLine <> "new" Then
    ExeDDEMessage VBServerName, VBTopicName, "SecNettalkApp show " + LastCommandLine
  Else
    If Right(App.Path, 1) = "\" Then AppPath = App.Path Else AppPath = App.Path + "\"
    
    If Len(Dir(AppPath + "OpenSSL.dll")) > 0 Then
      SSLIsAvailable = True
    End If
    
    If Len(Dir(AppPath + "Runmode.ini")) Then
      Frif = FreeFile
      On Error Resume Next
      Open AppPath + "Runmode.ini" For Input As #Frif
        Do Until EOF(Frif)
          Line Input #Frif, DAT
          If InStr(1, DAT, "singelusermode", vbTextCompare) > 0 Then I = Abs(InStr(1, DAT, "1") > 0)
          If InStr(1, DAT, "singleusermode", vbTextCompare) > 0 Then I = Abs(InStr(1, DAT, "1") > 0)
          If InStr(1, DAT, "noregentry", vbTextCompare) > 0 Then NoRegEntry = InStr(1, DAT, "1") > 0
          If InStr(1, DAT, "usessl", vbTextCompare) > 0 Then
            SSLIsAvailable = InStr(1, DAT, "1") > 0
          End If
        Loop
      Close #Frif
      On Error GoTo 0
    End If
    
    If I = 1 Then
      UserPath = AppPath + "Preferences\"
    Else
      UserPath = GetAppPath + "\Nettalk\"
    End If
    
    On Error Resume Next
    If Len(Dir(UserPath + "*.*")) = 0 Then
      MkDir UserPath
      UserPath = AppPath
    End If
    On Error GoTo 0
        
    Load Form1
    
    If I = 1 Then
      UserPath = AppPath + "Preferences\"
    Else
      UserPath = GetAppPath + "\Nettalk\"
    End If
    If Len(LastCommandLine) > 0 And LastCommandLine <> "new" Then
      If Form1.WindowState = 1 Then Form1.WindowState = 0
      Form1.Visible = True
    End If
  End If
End Sub
