Attribute VB_Name = "StartUpCommand"
Option Explicit

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const ERROR_SUCCESS = 0&
Public Const KEY_READ As Long = &H20019
Public Const KEY_ALL_ACCESS As Long = 983103

Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Function PhraseCLine(Optional CommandStr As String) As Boolean
  Dim I As Integer
  Dim I2 As Integer
  Dim I3 As Integer
  Dim cConType As String
  Dim cServer As String
  Dim cUserPass As String
  Dim cPort As Long
  Dim cRoom As String
  Dim cUser As String
  Dim cNick As String
  Dim cFName As String
  Dim cFSize As Currency
  Dim cCommand As String
  Dim FromFile As Boolean
  Dim DAT As String
  Dim Frif As Integer
  Dim FTrans As FileTransfer
  Dim NoDCCAdd As Boolean
  
  If Len(LastCommandLine) = 0 Then Exit Function
  
  If LCase(Left(LastCommandLine, 14)) = "nettalk:update" Then ShowUpdater: PhraseCLine = True: Exit Function
  If LCase(Left(LastCommandLine, 12)) = "nettalk:help" Then HTMLHelp_ShowTopic Trim(Mid(LastCommandLine, 13)): PhraseCLine = True: Exit Function
  If Left(LastCommandLine, 1) = """" Then LastCommandLine = Mid(LastCommandLine, 2, Len(LastCommandLine) - 2)
  
  cCommand = CommandStr
  If InStr(1, LastCommandLine, "\") Then
    On Error Resume Next
    If Len(Dir(LastCommandLine)) Then
      Frif = FreeFile
      Open LastCommandLine For Input As #Frif
        Do Until EOF(Frif)
          Line Input #Frif, DAT
          I = InStr(1, DAT, ":")
          If I Then
            Select Case LCase(Left(DAT, I - 1))
              Case "server": cServer = Trim(Mid(DAT, I + 1))
              Case "port": cPort = Trim(Mid(DAT, I + 1))
              Case "channel": cRoom = Trim(Mid(DAT, I + 1))
              Case "command": cCommand = Trim(Mid(DAT, I + 1))
              Case "filename": cFName = Trim(Mid(DAT, I + 1))
              Case "filesize": cFSize = Int(Val(Mid(DAT, I + 1)) * 1024@ * 1024@)
            End Select
          End If
          If LCase(Left(Trim(DAT), 16)) = "#newscriptbegin " Then
            Close #Frif
            If InStr(1, ntScript, Trim(DAT), vbTextCompare) = 0 Then
              If MsgBox(TeVal.ExtWorning, vbExclamation + vbOKCancel) = vbOK Then
                Form1.LoadScriptFile LastCommandLine
                Form1.reStartScript
              End If
            End If
            cServer = ""
            Exit Function
          End If
        Loop
      Close #Frif
      cConType = "IRC"
    End If
    On Error Resume Next
  Else
    I2 = InStr(1, LastCommandLine, "://") + 2
    If I2 = 2 Then LastCommandLine = "irc://" + LastCommandLine: I2 = 6
    For I = I2 + 1 To Len(LastCommandLine)
      Select Case Mid(LastCommandLine, I, 1)
        Case "/"
          I3 = I3 + 1
        Case "\"
          Mid(LastCommandLine, I, 1) = "/"
          I3 = I3 + 1
        Case Chr(13), Chr(10)
          Exit Function 'An sonsten könnten gefährliche Befehle ausgeführt werden
        Case Else
          If I = Len(LastCommandLine) And I3 < 2 Then
            LastCommandLine = LastCommandLine + "/"
          End If
      End Select
    Next
    
    cConType = UCase(Left(LastCommandLine, I2 - 3))
    If LCase(Left(cConType, 8)) = "dontadd," Then
      NoDCCAdd = True
      cConType = Mid(cConType, 9)
    End If
    For I = I2 + 1 To Len(LastCommandLine)
      Select Case Mid(LastCommandLine, I, 1)
        Case "@"
          If Len(cServer) = 0 Then
            I3 = InStr(I2 + 1, LastCommandLine, ":")
            If I3 > I Or I3 = 0 Then I3 = I
            cNick = Mid(LastCommandLine, I2 + 1, I3 - I2 - 1)
            If I > I3 Then
              cUserPass = Mid(LastCommandLine, I3 + 1, I - I3 - 1)
            End If
            I2 = I
          End If
        Case "/"
          If Len(cServer) = 0 Then
            I3 = InStr(I2 + 1, LastCommandLine, ":")
            If I3 > I Or I3 = 0 Then
              If cConType = "IRC" Then cPort = 6667
              If cConType = "DCC" Then cPort = 59
              I3 = I
            Else
              cPort = Val(Mid(LastCommandLine, I3 + 1, I - I3 - 1))
            End If
            cServer = Mid(LastCommandLine, I2 + 1, I3 - I2 - 1)
          ElseIf Len(cRoom) = 0 Then
            cRoom = Mid(LastCommandLine, I2 + 1, I - I2 - 1)
          Else
            Exit For
          End If
          I2 = I
      End Select
    Next
    
    If I2 < I Then cUser = Mid(LastCommandLine, I2 + 1)
  
    I = InStr(1, cRoom, ",isnick", vbTextCompare)
    If I > 0 Then
      cUser = Left(cRoom, I - 1)
      cRoom = ""
    End If
  End If
    
  If Len(cServer) = 0 Then Exit Function
  Select Case cConType
    Case "IRC", "I", "NETTALK"
      If Len(cCommand) Then
        If Left(cCommand, 1) = "/" Then cCommand = Mid(cCommand, 2)
        I = InStr(1, cCommand, " ")
        If I = 0 Then I = 1
        If InStr(1, cCommand, Chr(13)) > 0 Or InStr(1, cCommand, Chr(10)) > 0 Then cCommand = ""
        Select Case LCase(Left(cCommand, I - 1))
          Case "msg", "privmsg", "notice", "print", "ctcp"
          Case Else: cCommand = ""
        End Select
        If Len(cCommand) Then
          If ExDccConnExisting(cCommand, cFName, cServer, cPort, cRoom) = False And NoDCCAdd = False Then
            If Len(cFName) = 0 Then cFName = "Packet " + CutDirFromPath(cCommand, " ", True)
            If cFSize = 0 Then cFSize = 1
            Set FTrans = New FileTransfer
            FTrans.FileName = CheckTList(cFName)
            FTrans.SenderFN = cFName
            FTrans.FileSize = cFSize
            I2 = InStr(I + 1, cCommand, " ")
            If I2 > I Then FTrans.User = Mid(cCommand, I + 1, I2 - I - 1)
            FTrans.DestPath = ""
            FTrans.PeerIP = ""
            FTrans.NoteServer = cServer
            FTrans.NotePort = cPort
            FTrans.NoteCType = "IRC://"
            FTrans.NoteRoom = cRoom
            FTrans.RequCommand = cCommand
            FTrans.PeerPort = 0
            FTrans.ByteCount = 0
            FTrans.SendGetMode = 1
            ShowDCCFrame
            DCCFileConns.Add FTrans
            AddDCCFileList FTrans
          End If
        End If
      End If
      For I = 1 To IRCconns.Count
        If (LCase(IRCconns(I).Server) = LCase(cServer) Or LCase(IRCconns(I).RealServer) = LCase(cServer)) And IRCconns(I).Port = cPort Then
          If IRCconns(I).State < 4 Then IRCconns(I).Connect
          I3 = 1
          For I2 = 1 To ChatFrames.Count
            If ChatFrames(I2).IrcConn Is IRCconns(I) Then
              If ChatFrames(I2).FrameType = cfStatus Then
                If Len(cUser) > 0 Then IRCconns(I).SendComm "query " + cUser, ChatFrames(I2)
                If Len(cNick) > 0 Then IRCconns(I).SendComm "nick " + cNick, ChatFrames(I2)
                If Len(cRoom) > 0 Then
                  IRCconns(I).SendComm "join " + cRoom, ChatFrames(I2)
                Else
                  If Len(cUser) = 0 Then SetFrontFrame ChatFrames(I2)
                End If
              ElseIf ChatFrames(I2).FrameType = cfRoom And Len(cUser) = 0 Then
                If ChatFrames(I2).IrcConn.ChatNoSign(LCase(ChatFrames(I2).Caption)) = ChatFrames(I2).IrcConn.ChatNoSign(LCase(cRoom)) Then
                  SetFrontFrame ChatFrames(I2)
                  If Len(cCommand) > 0 Then
                    IRCconns(I).SendComm cCommand, ChatFrames(I2)
                    If ChatFrames(I2).TCHange And Not ChatFrames(I2).TextF Is Nothing Then ChatFrames(I2).TextF.Refresh: ChatFrames(I2).TCHange = False
                    I3 = 0
                  End If
                End If
              End If
            End If
          Next
          If I3 = 1 Then
            For I2 = 1 To ChatFrames.Count
              If ChatFrames(I2).IrcConn Is IRCconns(I) Then
                If ChatFrames(I2).FrameType = cfStatus Then
                  IRCconns(I).SendComm cCommand, ChatFrames(I2)
                  If ChatFrames(I2).TCHange And Not ChatFrames(I2).TextF Is Nothing Then ChatFrames(I2).TextF.Refresh: ChatFrames(I2).TCHange = False
                End If
              End If
            Next
          End If
          Exit Function
        End If
      Next
    Case "DCC", "D"
      StartDCCConnection "DCC:CHAT Server " + cServer + " " + CStr(cPort) + " -1 chat Client", False, Val(cRoom)
      Exit Function
    Case "TELNET", "T"
      If cRoom = CStr(Val(cRoom)) Then I = Val(cRoom) Else I = 1
      StartDCCConnection "DCC:CHAT Server " + cServer + " " + CStr(cPort) + " -1 chat Client", False, I
      Exit Function
    Case Else
      Exit Function
  End Select
  
  For I = 0 To ConnListCount - 1
    If LCase(ConnList(I).Server) = LCase(cServer) _
    And LCase(ConnList(I).Port) = LCase(cPort) _
    And (Len(cNick) = 0 Or cNick = ConnList(I).Nick) _
    And (Len(cUserPass) = 0 Or cUserPass = ConnList(I).Pass) And ConnList(I).State = 0 Then
      Exit For
    End If
  Next
  
  If I > ConnListCount - 1 Then
    ReDim Preserve ConnList(ConnListCount)
    I = ConnListCount
    ConnListCount = ConnListCount + 1
    ConnList(I).Caption = CheckConns("Server:" + cServer)
    ConnList(I).CreateType = 1
    ConnList(I).CreateDate = Now
    ConnList(I).Temp = 1
    ConnList(I).UTF8 = 0
    ConnList(I).UTF8dyn = Abs(CInt(UTF8on))
    ConnList(I).CodePage = BasicCodepage
    If Len(cNick) = 0 Then
      If Len(LastUsedNick) > 0 Then ConnList(I).Nick = LastUsedNick
    Else
      ConnList(I).Nick = cNick
    End If
    ConnList(I).Pass = cUserPass
    ConnList(I).Server = cServer
    ConnList(I).Port = cPort
    ConnList(I).UseSSL = 0
  End If
  
  If Len(cRoom) > 0 Then
    If Right(ConnList(I).Commands, 2) <> vbNewLine And Len(ConnList(I).Commands) > 0 Then
      ConnList(I).Commands = ConnList(I).Commands + vbNewLine
    End If
    ConnList(I).Commands = "$join " + cRoom
  End If

  If Len(cUser) > 0 Then
    If Right(ConnList(I).Commands, 2) <> vbNewLine And Len(ConnList(I).Commands) > 0 Then
      ConnList(I).Commands = ConnList(I).Commands + vbNewLine
    End If
    ConnList(I).Commands = ConnList(I).Commands + "$query " + cUser
  End If
  
  If Len(cCommand) > 0 Then
    If Right(ConnList(I).Commands, 2) <> vbNewLine And Len(ConnList(I).Commands) > 0 Then
      ConnList(I).Commands = ConnList(I).Commands + vbNewLine
    End If
    ConnList(I).Commands = ConnList(I).Commands + "$" + cCommand
    ConnList(I).Silent = True
  End If
  StartConnection I
End Function

Public Sub CheckReg()
  Dim IPath As String
  IPath = AppPath + App.EXEName + ".exe"
  SetProtokoll "nettalk", "Nettalk-Chat", """" + AppPath + App.EXEName + ".exe"" ""%1""", IPath
  SetProtokoll "irc", "Nettalk-Chat", """" + AppPath + App.EXEName + ".exe"" ""%1""", IPath
  SetProtokoll "dcc", "Nettalk-Chat", """" + AppPath + App.EXEName + ".exe"" ""%1""", IPath
End Sub

Public Sub SetProtokoll(Name As String, Description As String, AppPath As String, IconPath As String)
  If GetSettingString(HKEY_CLASSES_ROOT, Name + "\Shell\open\command", "") <> AppPath Then
    
    'Löschen
    DeleteKey HKEY_CURRENT_USER, "Software\Classes\" + Name + "\Shell\open\ddeexec\Application"
    DeleteKey HKEY_CURRENT_USER, "Software\Classes\" + Name + "\Shell\open\ddeexec\ifexec"
    DeleteKey HKEY_CURRENT_USER, "Software\Classes\" + Name + "\Shell\open\ddeexec\Topic"
    DeleteKey HKEY_CURRENT_USER, "Software\Classes\" + Name + "\Shell\open\ddeexec"
    DeleteKey HKEY_CURRENT_USER, "Software\Classes\" + Name + "\Shell\open\command"
    DeleteKey HKEY_CURRENT_USER, "Software\Classes\" + Name + "\DefaultIcon"
    
    'Neu erstellen
    CreateKey HKEY_CURRENT_USER, "Software\Classes\" + Name + "\Shell\open\command"
    SaveSettingString HKEY_CURRENT_USER, "Software\Classes\" + Name, "URL Protocol", Description
    SaveSettingString HKEY_CURRENT_USER, "Software\Classes\" + Name + "\Shell\open\command", "", AppPath
    
    CreateKey HKEY_CURRENT_USER, "Software\Classes\" + Name + "\DefaultIcon"
    SaveSettingString HKEY_CURRENT_USER, "Software\Classes\" + Name + "\DefaultIcon", "", IconPath
  End If
End Sub



Private Sub CreateKey(hKey As Long, strPath As String)
  Dim hCurKey As Long
  Dim lRegResult As Long
  lRegResult = RegCreateKey(hKey, strPath, hCurKey)
  lRegResult = RegCloseKey(hCurKey)
End Sub

Private Function GetSettingString(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String
  Dim hCurKey As Long
  Dim lValueType As Long
  Dim strBuffer As String
  Dim lDataBufferSize As Long
  Dim intZeroPos As Integer
  Dim lRegResult As Long
  If Not IsEmpty(Default) Then
    GetSettingString = Default
  Else
    GetSettingString = ""
  End If
  lRegResult = RegOpenKey(hKey, strPath, hCurKey)
  lRegResult = RegQueryValueEx(hCurKey, strValue, 0, lValueType, ByVal 0, lDataBufferSize)
  If lRegResult = ERROR_SUCCESS Then
    If lValueType = REG_SZ Then
      strBuffer = String(lDataBufferSize, " ")
      lRegResult = RegQueryValueEx(hCurKey, strValue, 0, 0, ByVal strBuffer, lDataBufferSize)
      intZeroPos = InStr(strBuffer, Chr$(0))
      If intZeroPos > 0 Then
        GetSettingString = Left$(strBuffer, intZeroPos - 1)
      Else
        GetSettingString = strBuffer
      End If
    End If
  End If
  lRegResult = RegCloseKey(hCurKey)
End Function

Private Sub SaveSettingString(hKey As Long, strPath As String, strValue As String, strData As String)
  Dim hCurKey As Long
  Dim lRegResult As Long
  lRegResult = RegCreateKey(hKey, strPath, hCurKey)
  lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
  lRegResult = RegCloseKey(hCurKey)
End Sub

Private Sub DeleteKey(ByVal hKey As Long, ByVal strPath As String)
  Dim lRegResult As Long
  lRegResult = RegDeleteKey(hKey, strPath)
End Sub

Private Sub DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
  Dim hCurKey As Long
  Dim lRegResult As Long
  lRegResult = RegOpenKey(hKey, strPath, hCurKey)
  lRegResult = RegDeleteValue(hCurKey, strValue)
  lRegResult = RegCloseKey(hCurKey)
End Sub
