Basic IRC Bot with Perl

use IO::Socket;
$irc='irc.example.net';
$nick='ตั้งชื่อบอท';
$owner='ชื่อคนใช้บอท';
$channel='#channel';
########################################################################
system('cls');
print "\n [+] Connection To $irc Please Wait ...\n\n";
########################################################################
$connect=IO::Socket::INET->new(PeerAddr=>$irc,
PeerPort=>'6667',
Proto=>'tcp',
Timeout=>60) or die "[!] Couldnt Connect To $irc\n\n";
#########################################################################
print $connect "USER xxx xxx xxx xxx\r\n";
print $connect "NICK ".$nick."\r\n";
print $connect "JOIN ".$channel."\r\n";
######################-  Loop Connection -##############################
while ($svrmsg=<$connect>) {
 if ($svrmsg=~m/^\:(.+?)\s+433/i) {
  die "NickName in use";
 }
 print $svrmsg;
 if ($svrmsg=~m/^PING (.*?)$/gi) {
  print $connect "PONG ".$1."\r\n";
  print "PONG ".$1."\r\n";
 }
########################################################################
 if ($svrmsg=~/Where you from ?/) {
  if ($svrmsg=~/^\:$owner\!/) {
 
   print $connect "PRIVMSG ",$channel," :I'm Form Thailand\r\n";
  
  }
 }
} 

List of Algorithms Used in CMS.

List Mouse Movement [ VB6 ]

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, lParam As Any) As Long

Const LB_ITEMFROMPOINT = &H1A9

Function MAKELPARAM(ByVal X As Integer, ByVal Y As Integer) As Long
    MAKELPARAM = CInt(Y) * (2 ^ 16) Or CInt(X)
End Function

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim CoordX As Long, CoordY As Long, Coord As Long, FPoint As Long
    Dim txt As String
   
    CoordX = X \ Screen.TwipsPerPixelX
    CoordY = Y \ Screen.TwipsPerPixelY
    Coord = MAKELPARAM(CInt(CoordX), CInt(CoordY))
    FPoint = SendMessage(List1.hWnd, LB_ITEMFROMPOINT, 0, ByVal Coord)
   
    If FPoint <= List1.ListCount - 1 Then
        txt = List1.List(FPoint)
        Select Case txt
            Case List1.List(0)
          Text1.Text = "ICheer_No0M"
            Case List1.List(1)
          Text1.Text = "bla bla bla bla" 
            Case List1.List(2)
          Text1.Text = "bla bla bla bla"

        End Select
       
    End If
       
End Sub

Form Moving [ VB6 ]

Private XX As Integer
Private YY As Integer
Dim MoveMe As Boolean

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MoveMe = True
XX = X
YY = Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MoveMe = True Then
Me.Left = Me.Left + (X - XX)
Me.Top = Me.Top + (Y - YY)
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Left = Me.Left + (X - XX)
Me.Top = Me.Top + (Y - YY)
MoveMe = False
End Sub

Minimize To Tray [ VB6 ]

ใ่ส่ไว้ที่ Form นะครับ …

Dim nid As NOTIFYICONDATA
Sub minimize_to_tray()
Me.Hide
nid.cbSize = Len(nid)
nid.hwnd = Me.hwnd
nid.uId = vbNull
nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
nid.uCallBackMessage = WM_MOUSEMOVE
nid.hIcon = Me.Icon
nid.szTip = "blablabla text u want to show when mouse over tray iicon" & vbNullChar
Shell_NotifyIcon NIM_ADD, nid
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim msg As Long
Dim sFilter As String
msg = x / Screen.TwipsPerPixelX
Select Case msg
Case WM_LBUTTONDOWN
Me.Show
Shell_NotifyIcon NIM_DELETE, nid
Case WM_LBUTTONUP
Case WM_LBUTTONDBLCLK
Case WM_RBUTTONDOWN
Case WM_RBUTTONUP
Me.Show
Shell_NotifyIcon NIM_DELETE, nid
Case WM_RBUTTONDBLCLK
End Select

End Sub
Private Sub Form_Unload(Cancel As Integer)
Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub form_resize()
   If (Me.WindowState = vbMinimized) Then
   minimize_to_tray
      Me.Visible = False
   End If
End Sub

ใส่ที่ Module ครับ ...

Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
uCallBackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205

Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

AutoCheck ListBox [ VB6 ]

Private Sub Form_Load()
    Dim itd As Integer
   
    For itd = 0 To List1.ListCount - 1
        List1.Selected(itd) = True
    Next itd
   
End Sub

ListBox แบบ Check ถ้ารันมามันจะไม่ Checked ใช่ไหมครับ ลองเอาโค้ดนี้ไปใส่ดูครับผม ...

เมื่อรันมามันจะมีเครื่องหมายติ๊กถูกมาเลยน่ะครับ ...

Transparent From [ VB6 ]

ใส่ใน Form ครับ …

Private Sub Form_Load()
ActiveTransparency Me, True, False, 200, &H0&
'ActiveTransparency [ชื่อ Form], True, False, [ค่าความโปร่งใส 1 - 255], [สีที่ต้องการให้ทลุ]
End Sub

ใส่ใน Module ครับ …

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bDefaut As Byte, ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE As Long = (-20)
Private Const LWA_COLORKEY As Long = &H1
Private Const LWA_Defaut As Long = &H2
Private Const WS_EX_LAYERED As Long = &H80000

Public Function Transparency(ByVal hwnd As Long, Optional ByVal Col As Long = vbBlack, _
Optional ByVal PcTransp As Byte = 255, Optional ByVal TrMode As Boolean = True) As Boolean

Dim DisplayStyle As Long
On Error Resume Next
VoirStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
If DisplayStyle <> (DisplayStyle Or WS_EX_LAYERED) Then
DisplayStyle = (DisplayStyle Or WS_EX_LAYERED)
Call SetWindowLong(hwnd, GWL_EXSTYLE, DisplayStyle)
End If
Transparency = (SetLayeredWindowAttributes(hwnd, Col, PcTransp, IIf(TrMode, LWA_COLORKEY Or LWA_Defaut, LWA_COLORKEY)) <> 0)

If Not Err.Number = 0 Then Err.Clear

End Function

Public Sub ActiveTransparency(M As Form, d As Boolean, F As Boolean, _
T_Transparency As Integer, Optional Color As Long)
Dim B As Boolean
If d And F Then
B = Transparency(M.hwnd, Color, T_Transparency, False)
ElseIf d Then
B = Transparency(M.hwnd, 0, T_Transparency, True)
Else
B = Transparency(M.hwnd, , 255, True)
End If
End Sub

เท่านี้ Code HTML จาก URL ที่ใส่ใน Text2 ก็จะมาอยู่ใน Text1 แล้วครับ

Effect On TitleBar [ VB6 ]

Private Sub Timer1_Timer()
Static Text As String
Static intC As Integer
On Error Resume Next
Text = Space(30) & "ใส่ข้อความที่จะให้ปรากฎตรง Title Bar"
Caption = Mid(Text, intC, 30)
intC = intC + 1
If intC = Len(Text) Then intC = 0
End Sub

ตั้ง Interval ใน Timer สักประมาณ 150 นะครับ (ยิ่งน้อยยิ่งเคลื่อนที่เร็ว)
Credit By siamdev

ดัดแปลงโค้ดเป็นวัตถุอื่นก็ได้ครับ ไม่ใช่ TitleBar อย่างเดียวก็ได้ลองประยุกต์กันดูครับผม …

Mouse Movement [ VB6 ]

สร้าง CommandButton 1 อันและ TextBox 1 อัน …

แล้วใส่โค้ด …

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Text = "ICheer_No0M"
End Sub

เมื่อเลื่อนเมาส์ไปที่ CommandButton 1 นะครับ ...

ในช่อง Text1 จะเป็นคำว่า ICheer_No0M นะครับ ...

Check Internet Connection [ VB6 ]

Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef dwflags As Long, _
  ByVal dwReserved As Long) As Long
Private Const CONNECT_LAN As Long = &H2
  Private Const CONNECT_MODEM As Long = &H1
  Private Const CONNECT_PROXY As Long = &H4
  Private Const CONNECT_OFFLINE As Long = &H20
  Private Const CONNECT_CONFIGURED As Long = &H40

Public Function IsWebConnected(Optional ByRef ConnType As String) As Boolean
      Dim dwflags As Long
      Dim WebTest As Boolean
      ConnType = ""
      WebTest = InternetGetConnectedState(dwflags, 0&)
      Select Case WebTest
          Case dwflags And CONNECT_LAN: ConnType = "LAN"
          Case dwflags And CONNECT_MODEM: ConnType = "Modem"
          Case dwflags And CONNECT_PROXY: ConnType = "Proxy"
          Case dwflags And CONNECT_OFFLINE: ConnType = "Offline"
          Case dwflags And CONNECT_CONFIGURED: ConnType = "Configured"
          Case dwflags And CONNECT_RAS: ConnType = "Remote"
      End Select
      IsWebConnected = WebTest
  End Function
  Private Sub Command1_Click()
      Dim msg As String
      If IsWebConnected(msg) Then
          msg = "You are connected to the Internet via : " & msg
      Else
          msg = "You are not connected to the Internet."
      End If
     
      MsgBox msg, vbOKOnly, "Internet Connection Status"
  End Sub

สร้าง Command มา 1 อันครับ ...

Run at StartUp [ VB6 ]

Private Sub Command1_Click()
Dim Startup_key As String
    Startup_key = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\"
    Dim Reg As Object
    Set Reg = CreateObject("wscript.shell")
    Reg.RegWrite Startup_key & App.EXEName, App.Path & "\" & App.EXEName & ".exe"

ให้โปรแกรมเปิดตอน Startup โดยการฝังตัวเองลงในจุด Startup ของ Registry