CONVERT MSACCESS TO ORACLE

 Source code dibawah ini merupkan code untuk meng-
konverikan suatu database msAccess ke Oracle.
1. Buatlah 1 Project(name=Convert.vbp)
2. Tambahkan 1 Form(name=FrmAccessToOracle)
3. Tambahkan 1 SSTab(Tabs=3,TabsPerRow=3)
 a. Tab=0,caption=1.Asal Database
    Tambahkan Label1(caption=Nama MsAccse-
    ss Database),TextBox(name=TxMdbName),
    CommandButton(name=CmdBrowse,Caption=
    Browse),CheckBox(name=CheckPassword,cap-
    tion=Password),TextBox(name=TxPassword,
    PasswordChar=*),Label(name=LabelOpenMsA-
    ccess,Capt=open MsAccess database. . . .)
    CommandButton(name=CmdCancel1,Capt=Batal)
    CommandButton(name=CmdNext1,Capt=Beriku-
    tnya >),Commondialog.
 b. Tab=1,capt=2.Target Database
    Tambahkan Label(Capt=Database),TextBox(
    name=TxDatabaseOracle),label(Capt=User
    Name),TextBox(name=TxUserOracle),Label
    (Capt=Password),TextBox(name=TxPasswordOr-
    acle),CommandButton(name=CmdOpenConnection,
    Open connection)Label(name=LabelOpenOracle,
    Capt=Open connection Oracle Database.....)
    CommandButton(name=CmdCancel2,Capt=Batal)
    CommandButton(name=CmdBack2,capt=    nya)CommandButton(name=CmdNext2,capt=Beri-
    kutnya>)
 c. Tab=2,capt=3.Pilih Tabel
    Label(capt=Daftar Tabel)ListBox(name=ListA-
    vailableTable)CommandButton(name=CmdAdd,Ca-
    pt=Tambahkan>)CommandButton(name=CmdAddAll,
    Capt=Tambahkan semua>>)CommandButton(name=
    CmdRemove,capt=< Buang)commandButton(name=
    CmdRemoveAll,capt=<< Buang Semua)Label(Capt=
    Table Yang Dipilih)ListBox(name=ListSele-
    ctedTable)Label(name=LabelProsesTbl,capt=
    LabelProses Tabel)CommandButton(name=CmdC-
    ancel3,capt=Batal)CommandButton(name=CmdP-
    rev3,capt=< Kembali)CommandButton(name=Cm-
    dConvert,capt=Convert)

Copy coding dibawah ini dan paste di Editor Form:

Option Explicit
Dim CnAccess, CnOracle As ADODB.Connection
Dim cat As ADOX.Catalog

Private Sub CheckPassword_Click()
  If CheckPassword.Value = 0 Then
    TxPassword.Enabled = False
  Else
    TxPassword.Enabled = True
  End If
End Sub

Private Sub CmdAdd_Click()
Dim i As Byte
  i = 0
  Do
    If ListAvailableTable.Selected(i) Then
      ListSelectedTable.AddItem ListAvailableTable.List(i)
      ListAvailableTable.RemoveItem (i)
    End If
    i = i + 1
  Loop While i <= ListAvailableTable.ListCount - 1
  
End Sub

Private Sub CmdAddAll_Click()
Dim i As Byte
  i = 0
  Do
    ListSelectedTable.AddItem ListAvailableTable.List(i)
    i = i + 1
  Loop While i <= ListAvailableTable.ListCount - 1
  ListAvailableTable.Clear
End Sub

Private Sub CmdBack2_Click()
   SSTab1.Tab = 0
End Sub

Private Sub CmdBrowse_Click()
  CommonDialog1.CancelError = True
  CommonDialog1.Filter = "*.mdb"
  CommonDialog1.FileName = "*.mdb"
  On Error GoTo Batal
  CommonDialog1.ShowOpen
  TxMdbName.Text = CommonDialog1.FileName
Batal:
End Sub

Private Sub CmdCancel1_Click()
  Unload Me
End Sub

Private Sub CmdCancel2_Click()
  Unload Me
End Sub

Private Sub CmdCancel3_Click()
  Unload Me
End Sub

Private Sub CmdConvert_Click()
  ExportTablesADO
  LabelProsesTbl.Caption = ""
End Sub

Private Sub CmdNext1_Click()
Dim strCn As String
Dim NTbl, i As Byte
Dim X As ADOX.Table
   On Error GoTo BatalBuka
   LabelOpenMsAccess.Visible = True
   Me.Refresh
   strCn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
   strCn = strCn & TxMdbName.Text
   strCn = strCn & ";Persist Security Info=False"
   If CnAccess.State = 1 Then CnAccess.Close
   CnAccess.Open strCn
   cat.ActiveConnection = CnAccess
   
   ListSelectedTable.Clear
   ListAvailableTable.Clear
   NTbl = cat.Tables.Count ' - 1
   For Each X In cat.Tables
    ' If cat.Tables.Item(i).Type = "TABLE" Then
    '   ListAvailableTable.AddItem cat.Tables.Item(i).Name
    ' End If
     If X.Type = "TABLE" Then
       ListAvailableTable.AddItem X.Name
     End If
   Next
   SSTab1.Tab = 1
   LabelOpenMsAccess.Visible = False

   Exit Sub
BatalBuka:
   LabelOpenMsAccess.Visible = False
   MsgBox "Tidak bisa connect dengan MsAccess"
End Sub

Private Sub CmdNext2_Click()
Dim strCn As String
   LabelOpenOracle.Visible = True
   Me.Refresh
   strCn = "Provider=OraOLEDB.Oracle.1;Persist Security Info=False;" & _
           "User ID=" & TxUserOracle.Text & ";" & _
           "Password=" & TxPasswordOracle.Text & ";" & _
           "Data Source=" & TxDatabaseOracle.Text
           
   On Error GoTo BatalConnect
   If CnOracle.State = 1 Then CnOracle.Close
   CnOracle.Open strCn
   LabelOpenOracle.Visible = False
   SSTab1.Tab = 2
   Exit Sub
BatalConnect:
   LabelOpenOracle.Visible = False
   MsgBox "Tidak bisa connect dengan Oracle"
End Sub

Private Sub ExportTablesADO()
Dim aRs, oRs As ADODB.Recordset
Dim TblName, TblAName, TblOName As String
Dim NTbl, NFld, NIdx, NICol As Byte
Dim i, j, k As Integer

Dim StrTbl, StrFld As String
Dim StrIdx As String
Dim idxField As String

Dim Nkey As Byte
Dim StrKey As String
Dim keyName, keyType As String
Dim keyRelatedTable As String
Dim keyField As String
Dim keyRelatedField As String

   Set aRs = New ADODB.Recordset
   Set oRs = New ADODB.Recordset
   aRs.ActiveConnection = CnAccess
   aRs.CursorLocation = adUseClient
   aRs.CursorType = adOpenStatic
   aRs.LockType = adLockReadOnly
   
   
   On Error GoTo GagalExport
   NTbl = ListSelectedTable.ListCount - 1
   For i = 0 To NTbl
       'Create Table
       TblAName = "[" & ListSelectedTable.List(i) & "]"
       TblOName = CekSpasi(CStr(ListSelectedTable.List(i)))
       TblName = ListSelectedTable.List(i)
       StrTbl = "CREATE TABLE " & TblOName & vbCrLf & " ("
       
       aRs.Open "Select * From " & TblAName
       NFld = aRs.Fields.Count - 1
       LabelProsesTbl.Caption = TblName
       Me.Refresh
      
       For j = 0 To NFld
         LabelProsesTbl.Caption = TblName & "/" & "Create table"
         Me.Refresh
         StrFld = CekSpasi(CStr(aRs.Fields(j).Name)) & " "
          Select Case aRs.Fields(j).Type
            Case 202 'Text
               StrFld = StrFld & "VARCHAR2 " & "(" & aRs.Fields(j).DefinedSize & ")"
            Case 203 'Memo
              StrFld = StrFld & "CLOB"
            Case 3 'Long
              StrFld = StrFld & "NUMBER(11)"
            Case 17 'Byte
              StrFld = StrFld & "NUMBER(3)"
            Case 2 'Integer
              StrFld = StrFld & "NUMBER(5)"
            Case 4 'Single
              StrFld = StrFld & "REAL"
            Case 5 'Double
              StrFld = StrFld & "FLOAT"
            Case 72 'Replication ID
              StrFld = StrFld & "RAW(16)"
            Case 7 'Date
              StrFld = StrFld & "DATE"
            Case 131 'Decimal
              StrFld = StrFld & "NUMBER(18,0)"
            Case 6 'Currency
              StrFld = StrFld & "NUMBER(18,2)"
            Case 11 'YesNo
              StrFld = StrFld & "NUMBER(3)"
            Case 205 'OLE
              StrFld = StrFld & "BLOB"
            Case 20 'Hyperlink
              StrFld = StrFld & "CLOB"
            Case Else
              StrFld = StrFld & "VARCHAR2 " & "(" & aRs.Fields(j).DefinedSize & ")"
          End Select
          If j < NFld Then
            StrFld = StrFld & ","
          End If
          StrTbl = StrTbl & StrFld
          
       Next
       
       'Add Index
       StrIdx = ""
       If cat.Tables(TblName).Indexes.Count > 0 Then
         NIdx = cat.Tables(TblName).Indexes.Count - 1
         TblName = cat.Tables(TblName).Name
       
         For j = 0 To NIdx
           If cat.Tables(TblName).Indexes.Item(j).PrimaryKey Then
             LabelProsesTbl.Caption = TblName & "/" & "Add index"
             Me.Refresh
             StrIdx = "Primary Key ("
             NICol = cat.Tables(TblName).Indexes.Item(j).Columns.Count - 1
             For k = 0 To NICol
               idxField = CekSpasi(CStr(cat.Tables(TblName).Indexes.Item(j).Columns.Item(k).Name))
               StrIdx = StrIdx & idxField
               If k < NICol Then
                 StrIdx = StrIdx & ","
               Else
                 StrIdx = StrIdx & ")"
               End If
             Next
           End If
         Next
       End If
       If StrIdx <> "" Then
         StrTbl = StrTbl & ", " & vbCrLf & StrIdx
       End If
       
       StrTbl = StrTbl & ") "
              
       CnOracle.Execute StrTbl
       StrTbl = ""
       
       'Export data
       LabelProsesTbl.Caption = TblName & "/" & "export data"
       Me.Refresh
       oRs.CursorLocation = adUseServer
       oRs.LockType = adLockOptimistic
       oRs.CursorType = adOpenDynamic
       oRs.Open "Select * From " & TblOName, CnOracle
       j = aRs.Fields.Count - 1
       While Not aRs.EOF
         oRs.AddNew
         For k = 0 To j
           oRs.Fields(k).Value = aRs.Fields(k).Value
         Next
         oRs.Update
         aRs.MoveNext
       Wend
       oRs.Close
       aRs.Close
   Next i
     
   'Add Check constraint
   For i = 0 To NTbl
       TblName = ListSelectedTable.List(i)
       TblOName = CekSpasi(CStr(TblName))
       NFld = cat.Tables(ListSelectedTable.List(i)).Columns.Count - 1
       
       k = 0
       For j = 0 To NFld
         If cat.Tables(TblName).Columns(j).Properties.Item(8).Value <> "" Then
           LabelProsesTbl.Caption = TblName & "/" & "Add CHECK constraint "
           Me.Refresh
           k = k + 1
           StrTbl = "ALTER TABLE " & TblOName & " ADD CONSTRAINT "
           StrTbl = StrTbl & TblOName & Format(k, "00") & vbCrLf & "CHECK ("
           StrTbl = StrTbl & cat.Tables(TblName).Columns(j).Name & " "
           StrTbl = StrTbl & cat.Tables(TblName).Columns(j).Properties.Item(8).Value
           StrTbl = StrTbl & ") ENABLE Validate"
           CnOracle.Execute StrTbl
         End If
       Next
       
    Next i
    
   'Add Foreign key
   For i = 0 To NTbl
       TblAName = "[" & ListSelectedTable.List(i) & "]"
       TblOName = CekSpasi(CStr(ListSelectedTable.List(i)))
       TblName = ListSelectedTable.List(i)
       
       If cat.Tables(TblName).Keys.Count > 0 Then
         Nkey = cat.Tables(TblName).Keys.Count - 1
         LabelProsesTbl.Caption = TblName & "/" & "Add Foreign key constraint"
         Me.Refresh
         'TblOName = CekSpasi(CStr(cat.Tables(TblName).Name))
         For j = 0 To Nkey
           StrKey = ""
           If cat.Tables(TblName).Keys.Item(j).Type = 2 Then
             keyName = CekSpasi(CStr(cat.Tables(TblName).Keys.Item(j).Name))
             keyRelatedTable = CekSpasi(CStr(cat.Tables(TblName).Keys.Item(j).RelatedTable))
             StrKey = "ALTER TABLE " & TblOName & " ADD (FOREIGN KEY ("
             NICol = cat.Tables(TblName).Keys.Item(j).Columns.Count - 1
             For k = 0 To NICol
               idxField = CekSpasi(CStr(cat.Tables(TblName).Keys.Item(j).Columns.Item(k).Name))
               StrKey = StrKey & idxField
               If k < NICol Then
                 StrKey = StrKey & ","
               Else
                 StrKey = StrKey & ")"
               End If
             Next
             StrKey = StrKey & " References " & keyRelatedTable & " ("
             For k = 0 To NICol
               keyRelatedField = CekSpasi(CStr(cat.Tables(TblName).Keys.Item(j).Columns.Item(k).RelatedColumn))
               StrKey = StrKey & keyRelatedField
               If k < NICol Then
                 StrKey = StrKey & ","
               Else
                 StrKey = StrKey & ")"
               End If
             Next
             StrKey = StrKey & ")"
             
             CnOracle.Execute StrKey

           End If
         Next
       End If
   Next i
   LabelProsesTbl.Caption = "Selesai"
   Me.Refresh
   MsgBox "Export ke oracle Selesai"

   Exit Sub
GagalExport:
  MsgBox "Export ke oracle gagal " & vbCrLf & _
         Err.Description
  
End Sub


Private Sub CmdPrev3_Click()
   SSTab1.Tab = 1
End Sub

Private Sub CmdRemove_Click()
Dim i As Byte
  i = 0
  Do
    If ListSelectedTable.Selected(i) Then
      ListAvailableTable.AddItem ListSelectedTable.List(i)
      ListSelectedTable.RemoveItem (i)
    End If
    i = i + 1
  Loop While i <= ListSelectedTable.ListCount - 1
  
End Sub

Private Sub CmdRemoveAll_Click()
Dim i As Byte
  i = 0
  Do
    ListAvailableTable.AddItem ListSelectedTable.List(i)
    i = i + 1
  Loop While i <= ListSelectedTable.ListCount - 1
  ListSelectedTable.Clear
End Sub


Private Sub Form_Load()
Dim i, NTbl As Integer
   Set CnAccess = New ADODB.Connection
   Set CnOracle = New ADODB.Connection
   Set cat = New ADOX.Catalog
   TxMdbName.Text = ""
   CheckPassword.Value = 0
   TxPassword.Enabled = False
   SSTab1.Tab = 0
   TxDatabaseOracle.Text = ""
   TxUserOracle.Text = ""
   TxPasswordOracle.Text = ""
   LabelOpenMsAccess.Visible = False
   LabelOpenOracle.Visible = False
   LabelProsesTbl.Caption = ""
End Sub

Private Function CekSpasi(X As String) As String
   CekSpasi = Replace(RTrim(X), " ", "_")
End Function

MENGECEK IP AKTIF

 Source code dibawah ini merupakan
suatu program untuk mengecek suatu Host Yang
aktif yaitu untuk mengetahui komputer mana
saja yang sedang aktif.
1. Bukalah 1 Project(name=ActiveIP.vbp)
2. Tambah 1 Form(name=frmCekIP)tambahkan:
   a. 1 ListBox
   b. 2 TextBox
   c. 1 CommandButton(name=CekIP)

Copy coding dibawah ini dan paste di Editor Form:

Option Explicit
Const SOCKET_ERROR = 0
Private Declare Function GetHostByName Lib "wsock32.dll" _
    Alias "gethostbyname" (ByVal HostName As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" _
    (ByVal wVersionRequired&, ipWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
    (ByVal HANDLE As Long) As Boolean
Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, _
    ByVal DestAddress As Long, ByVal RequestData As String, _
    ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, _
    ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean

Private Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To 255) As Byte
    szSystemStatus(0 To 128) As Byte
    iMaxsockets As Integer
    iMaxUdpDg As Integer
    ipVendorInfo As Long
End Type

Private Type Hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

Private Type IP_OPTION_INFORMATION
    TTL As Byte
    Tos As Byte
    Flags As Byte
    OptionsSize As Long
    OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
    Address(0 To 3) As Byte
    Status As Long
    RoundTripTime As Long
    DataSize As Integer
    Reserved As Integer
    data As Long
    Options As IP_OPTION_INFORMATION
End Type
Public dir As String


Public Function doPing(ByVal HostName As String) As Boolean
    Dim hFile As Long, ipWSAdata As WSAdata
    Dim hHostent As Hostent, Addrlist As Long
    Dim Address As Long, rIP As String
    Dim OptInfo As IP_OPTION_INFORMATION
    Dim EchoReply As IP_ECHO_REPLY
    Call WSAStartup(&H101, ipWSAdata)
    If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then
        CopyMemory hHostent.h_name, ByVal GetHostByName(HostName + String(64 - Len(HostName), 0)), Len(hHostent)
        CopyMemory Addrlist, ByVal hHostent.h_addr_list, 4
        CopyMemory Address, ByVal Addrlist, 4
    End If
    hFile = IcmpCreateFile()
    If hFile = 0 Then
        MsgBox "Unable to create File Handle", vbCritical + vbOKOnly
        doPing = False
        Exit Function
    End If
    OptInfo.TTL = 225
    If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
        rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + _
            CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
    Else
        doPing = False
    End If
    If EchoReply.Status = 0 Then
        doPing = True
    Else
        doPing = False
    End If
    Call IcmpCloseHandle(hFile)
    Call WSACleanup
End Function

Private Sub Command1_click()
    Dim i As Integer
    Dim x, y
    Dim result As Boolean
    Dim resultString As String
    If Trim(Text1) = "" Then
        MsgBox "Isikan alamat IP", vbCritical + vbOKOnly
        Exit Sub
    End If
    List1.Clear
    x = Split(Text1.Text, ".")
    y = Split(Text2.Text, ".")
    For i = CInt(x(3)) To CInt(y(3))
        dir = x(0) & "." & x(1) & "." & x(2) & "." & i
        result = doPing(dir)
    If result = True Then
        resultString = "Aktif"
    Else
        resultString = "Non-aktif"
    End If
    List1.AddItem "Pinging" & dir & "..." & resultString
    List1.Refresh
    Next
End Sub

CEK PORT TERBUKA

 Source code berikut merupakan program
untuk mencari Port yang terbuka.
1. Bukalah 1 Project(name:Port_Scanner.vbp)
2. Tambahkan 1 Form(name:frmPortScanner)
   Tambahkan:
   a. 5 TextBox dengan:
      Textbox1(name=TxtIP)
      Textbox2(name=TxtFrom)
      Textbox3(name=TxtTo)
      Textbox4(name=TxtTime)
      Textbox5(name=TxtData)
   b. 2 Timer dengan
      Timer1(name=TmrConnected,enable=false)
      Timer2(name=TimeOut,enable=false)
   c. 1 commandButton(name=scan)
   d. Winsock(name=sckScan)untuk menambahkan
      kontrol winsock dari menu Project-Components
      -beri tanda cek pada Microsoft Wincock
      control 6.0
   e. 1 Label(name=Lblscan)
   f. 1 ListBox(name=LstResult)

Copy coding dibawah ini dan paste di Editor Form:

 
Option Explicit
Dim Port As Single
Dim Scanning As Boolean
Dim RemoteOS As String
Dim PortType As Integer

Private Sub CmdScan_Click()
    If Scanning = False Then
        PortType = 0
        LstResult.Clear
        LstResult.AddItem "  Port:                     service:"
        LstResult.AddItem "=============================================="
        TxtFrom.Enabled = False
        TxtIP.Enabled = False
        TxtTime.Enabled = False
        TxtTo.Enabled = False
        TxtData.Enabled = False
        CmdScan.Caption = "&Cancel"
        Scanning = True
        Port = TxtFrom.Text + 1
        BeginScan
    Else
        TxtFrom.Enabled = True
        TxtIP.Enabled = True
        TxtTime.Enabled = True
        TxtTo.Enabled = True
        TxtData.Enabled = True
        CmdScan.Caption = "&Scan Again"
        Scanning = False
        TimeOut.Enabled = False
        TmrConnected.Enabled = False
        sckScan.Close
        Port = TxtTo.Text
        LblScan.Caption = ""
    End If
End Sub

Private Sub sckScan_Connect()
    TimeOut.Enabled = False
    sckScan.SendData "GET abcdef.htm" & vbCrLf & "USER abcdef" & vbCrLf & "FINGER abcdef" & vbCrLf
    TmrConnected.Interval = TxtData.Text
    TmrConnected.Enabled = True
End Sub

Private Sub sckScan_DataArrival(ByVal bytesTotal As Long)
    Dim Data As String
    sckScan.GetData Data, vbString
    If InStr(1, Data, vbLf) <> 0 Then
        RecognizePort Data
        sckScan.Close
        Port = Port + 1
        BeginScan
    End If
End Sub

Private Sub TimeOut_Timer()
    TimeOut.Enabled = False
    Port = Port + 1
    BeginScan
End Sub

Private Sub TmrConnected_Timer()
    LstResult.AddItem Format(sckScan.RemotePort, "  #00000 --------->>") & "  >Gue ga' tau...."
    TmrConnected.Enabled = False
    Port = Port + 1
    BeginScan
End Sub

Private Sub BeginScan()
    If Port <= TxtTo Then
        sckScan.Close
        sckScan.RemoteHost = TxtIP.Text
        sckScan.RemotePort = Port
        LblScan.Caption = "  Port: " & Port & "  @  " & sckScan.RemoteHost
        sckScan.Connect
        TimeOut.Interval = TxtTime.Text
        TimeOut.Enabled = True
        On Error Resume Next
    Else
        Call CmdScan_Click
    End If
End Sub

Private Sub RecognizePort()
    Dim MyType As String
    If InStr(1, Data, "FTP") > 0 Then
        MyType = "FTP Server"
        If InStr(1, Data, "Serv-U") > 0 Then
            MyType = MyType & "(Serv-U)"
        End If
    ElseIf InStr(1, UCase(Data), "HTTP") > 0 Or _
            InStr(1, UCase(Data), "HTML") > 0 Then
        MyType = "HTTP Server"
        If InStr(1, Data, "Microsoft") > 0 Then
            MyType = MyType & "(Microsoft)"
    ElseIf InStr(1, Data, "Apache") > 0 Then
            MyType = MyType & "(Apache)"
        End If
    ElseIf InStr(1, UCase(Data), "MAIL") > 0 Then
        MyType = "MAIL Server"
        If InStr(1, Data, "Microsoft") > 0 Then
            MyType = MyType & "(Microsoft)"
        End If
    ElseIf InStr(1, UCase(Data), "IMAP") > 0 Then
        MyType = "IMAP Server"
        If InStr(1, Data, "Microsoft") > 0 Then
            MyType = MyType & "(Microsoft)"
    ElseIf InStr(1, UCase(Data), "NNTP") > 0 Then
        MyType = "NNTP Server"
        If InStr(1, Data, "Microsoft") > 0 Then
            MyType = MyType & "(Microsoft)"
        End If
    ElseIf InStr(1, UCase(Data), "NOTICE AUTH") > 0 Then
        MyType = "IRC Server"
    ElseIf InStr(1, Data, "ERROR: Your host is trying too (re)connect too fast") > 0 Then
        MyType = "IRC Server"
    ElseIf Mid(Data, 1, Len("GET abscdef.htm")) = "GET abcdef.htm" Then
        MyType = "PING Server"
    Else
        MyType = "Ora Ngerti...."
    End If
    LstResult.AddItem Format(sckScan.RemotePort, "  #00000 --------->>") & "  >" & MyType
End Sub