myunits.pas

乐都SQL版传奇全套代码,绝对可编译

unit MyUnits;

interface
uses
  WinProcs, SysUtils, Classes,  WinSock, TlHelp32,Zlib,Md5;
type
  TResultArray = array of string;
  TIPFileter = record
    IP: Integer;
    num: Integer;
  end;
const
  Table: array[0..255] of DWord =
  ($00000000, $77073096, $EE0E612C, $990951BA,
    $076DC419, $706AF48F, $E963A535, $9E6495A3,
    $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
    $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
    $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
    $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
    $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
    $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
    $3B6E20C8, $4C69105E, $D56041E4, $A2677172,
    $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
    $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
    $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
    $26D930AC, $51DE003A, $C8D75180, $BFD06116,
    $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
    $2802B89E, $5F058808, $C60CD9B2, $B10BE924,
    $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
    $76DC4190, $01DB7106, $98D220BC, $EFD5102A,
    $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
    $7807C9A2, $0F00F934, $9609A88E, $E10E9818,
    $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
    $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
    $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
    $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
    $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
    $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
    $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
    $4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
    $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
    $5005713C, $270241AA, $BE0B1010, $C90C2086,
    $5768B525, $206F85B3, $B966D409, $CE61E49F,
    $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
    $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
    $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
    $EAD54739, $9DD277AF, $04DB2615, $73DC1683,
    $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
    $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
    $F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
    $F762575D, $806567CB, $196C3671, $6E6B06E7,
    $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
    $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
    $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
    $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
    $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
    $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
    $CB61B38C, $BC66831A, $256FD2A0, $5268E236,
    $CC0C7795, $BB0B4703, $220216B9, $5505262F,
    $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
    $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
    $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
    $9C0906A9, $EB0E363F, $72076785, $05005713,
    $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
    $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
    $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
    $81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
    $88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
    $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
    $A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
    $A7672661, $D06016F7, $4969474D, $3E6E77DB,
    $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
    $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
    $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
    $BAD03605, $CDD70693, $54DE5729, $23D967BF,
    $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);

  //通过域名得ip
function GetIPFromName(Name: string): string;
function LastPos(SubStr, s: string): string;
//检测是否别其他程序加载
procedure CheckParentProc;
//检测是否有filemon运行
function DetectFileMon: Boolean;
function SplitString(const Source, Ch: string): TResultArray;
function FastPosNoCase(const aSourceString, aFindString: string; const
  aSourceLen, aFindLen, StartPos: Integer): Integer;
function FastPos(const aSourceString, aFindString: string; const aSourceLen,
  aFindLen, StartPos: Integer): Integer;
procedure CalcCRC32(FileName: string; Len: Integer; var CRC32: DWord);
procedure DES(var Input; var Output; var Key; EnCrypt: Boolean);
function ReadStream(s: TStream; var Key; EnCrypt: Boolean): Boolean;
function QuickCRC32(data, crc: DWord): DWord;
function GetCrcFormStream(M:TStream;StartPos,EndPos:LongWord):LongWord;
function GetMd5FormStream(M:TStream;StartPos,EndPos:LongWord):String;

procedure CompressStream(var MyStream: TMemoryStream);
procedure UnCompressStream(var MyStream: TMemoryStream);
function EncryptNew(const InString:array of Byte;len:Integer; StartKey,MultKey,AddKey:Integer;Var OutBuf:Array of Byte): string;
function DecryptNew(const InString:array of Byte;len:Integer; StartKey,MultKey,AddKey:Integer;Var OutBuf:Array of Byte): string;
function SetByte(var buf:Array of Byte;Str:String):Boolean;
function ByteToString(Buf:Array of Byte):String;
function GetFileMd5(FileName:String):String;
implementation
var
CRC32Tab: array [0..255] of DWord;

function GetFileMd5(FileName:String):String;
var
  M:TMemoryStream;
  Crc:Longword;
  Md5:String;
Begin
  Result:='';

  Try
    M:=TMemoryStream.Create;
    if FileExists(FileName) then
    Begin
       M.LoadFromFile(FileName);
       Crc:=GetCrcFormStream(M,0,M.Size);
       Md5:=GetMd5FormStream(M,0,M.Size);
      Md5:=Inttostr(Crc)+Md5;
      Result:=Md5;
      // Result:=Pchar(Md5);
    End;
  Finally
    M.Free;
  End;

End;


//Len:文件最后len字节不校验
{*******************************************************
 * Standard Encryption algorithm - Copied from Borland *
 *******************************************************}
function EncryptNew(const InString:array of Byte;len:Integer; StartKey,MultKey,AddKey:Integer;Var OutBuf:Array of Byte): string;
var
  I : Byte;
begin
  Result := '';
  for I := 0 to Len-1 do
  begin
    OutBuf[i] := ((InString[I]) xor (StartKey shr 8));
    StartKey := (Byte(OutBuf[I]) + StartKey) * MultKey + AddKey;
  end;
end;
{*******************************************************
 * Standard Decryption algorithm - Copied from Borland *
 *******************************************************}
function DecryptNew(const InString:array of Byte;len:Integer; StartKey,MultKey,AddKey:Integer;Var OutBuf:Array of Byte): string;
var
  I : Byte;
begin
  Result := '';
  for I := 0 to Len-1 do
  begin
    OutBuf[i] :=(Byte(InString[I]) xor (StartKey shr 8));
    StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey;
  end;
end;

function SetByte(var buf:Array of Byte;Str:String):Boolean;
var
  Len,Len1:Integer;
  i,j:Integer;
  code:Byte;

Begin
  Result:=False;
  Len:=Length(str);
  if High(buf)<2*Len+1 then  exit;
  Buf[0]:=Len;
  for i:=1 to Len do
  Begin
    code:=Ord(Str[i]);
    Randomize;
    Buf[2*i-1]:=Random(255) and $aa;
    Buf[2*i]:=Random(255) and $aa;
    code:=Code and $AA;
    Buf[2*i-1]:=Buf[2*i-1] or (code shr 1);
    Code:=Ord(Str[i]) and $55;
    Buf[2*i]:=Buf[2*i] or (code );
  End;
  Len1:=High(buf);
  For i:=2*Len+1+1 to Len1-1 do
  Begin
     Randomize;
     Buf[i]:=Random(255);
  End;

  Result:=True;
End;
function ByteToString(Buf:Array of Byte):String;
var
  Len,i:Integer;
  code:Byte;
Begin
  Len:=Buf[0];
  SetLength(Result,Len);
  For i:=1 to Len do
  Begin
    Code:=Buf[2*i-1] and $55;
    Code:=code shl 1;
    code:=Code or (Buf[2*i] and $55);
    Result[i]:=Chr(code);
  End;
End;
procedure UnCompressStream(var MyStream: TMemoryStream);
var
  SourceStream: TDecompressionStream;
  Buffer: PChar;
  Count: Integer;
Begin
  MyStream.Seek(0,0);
  MyStream.ReadBuffer(Count, SizeOf(Count));
  GetMem(Buffer, Count);
  SourceStream := TDecompressionStream.Create(MyStream);
  Try
    SourceStream.ReadBuffer(Buffer^, Count);
    MyStream.Clear;
    MyStream.WriteBuffer(Buffer^, Count);
    MyStream.Position := 0;
  finally
    FreeMem(Buffer);
  end;
end;
procedure CompressStream(var MyStream: TMemoryStream);
var
  SourceStream: TCompressionStream;
  DestStream: TMemoryStream;
  Count: Integer;
Begin
  Count := MyStream.Size;
  MyStream.Seek(0,0);
  DestStream := TMemoryStream.Create;
  SourceStream:=TCompressionStream.Create(clDefault, DestStream);
  Try
    MyStream.SaveToStream(SourceStream);
    SourceStream.Free;
    MYStream.Clear;
    MyStream.WriteBuffer(Count, SizeOf(Count));
    MyStream.CopyFrom(DestStream, 0);
    MyStream.Position := 0;
  finally
    DestStream.Free;
  end;
end;
function CalCRC32(data, crc, genpoly: DWord): DWord;
var
  i: Integer;
begin
  // 方法1：摘自XMODEM协议, 模仿CRC16计算方法, 但是低位先行
  crc := crc xor data;
  for i:=0 to 7 do
    if (crc and $01) <> 0 then // 只测试最低位
      crc := (crc shr 1) xor genpoly // 最低位为1，移位和异或处理
    else crc := crc shr 1;           // 否则只移位（除2）
  Result := crc;
end;
procedure InitCRC32Tab(genpoly: DWord);
var
  i: Integer;
begin
  for i:=0 to 255 do
    CRC32Tab[i] := CalCRC32(i,0,genpoly);
end;

function QuickCRC32(data, crc: DWord): DWord;
begin
  crc := CRC32Tab[Byte(crc xor data)] xor (crc shr 8);
  Result := crc;
end;
//从流中获得CRC校验值
function GetCrcFormStream(M:TStream;StartPos,EndPos:LongWord):LongWord;
var
  Buf:Array of Byte;
  Count:LongWord;
  i:Integer;
Begin
  if EndPos=0 then
     Count:=M.Size
  else
     Count:=EndPos-StartPos;
  SetLength(Buf,Count);
  M.Seek(StartPos,0);
  M.Read(BUf[0],Count);
  Result:=0;
  For i:=0 to Count-1 do
    Result:=QuickCRC32(Buf[i],Result);
End;
function GetMd5FormStream(M:TStream;StartPos,EndPos:LongWord):String;
var
  Buf:Array of Byte;
  Count:LongWord;
  i:Integer;
Begin
  if EndPos=0 then
     Count:=M.Size
  else
     Count:=EndPos-StartPos;
  SetLength(Buf,Count);
  M.Seek(StartPos,0);
  M.Read(BUf[0],Count);
  Result:=GetMD5(@Buf[0],Count);
End;
procedure CalcCRC32(FileName: string; Len: Integer; var CRC32: DWord);
var
  F: file;
  BytesRead: DWord;
  Buffer: array[1..65521] of Byte;
  i: Word;
begin
  FileMode := 0;
  CRC32 := $FFFFFFFF;
{$I-}
  AssignFile(F, FileName);
  Reset(F, 1);
  if IOResult = 0 then
  begin
    repeat
      BlockRead(F, Buffer, SizeOf(Buffer), BytesRead);
      if BytesRead <> 65521 then
      begin
        for i := 1 to BytesRead - Len do
          CRC32 := (CRC32 shr 8) xor Table[Buffer[i] xor (CRC32 and $000000FF)];
      end
      else
        for i := 1 to BytesRead do
          CRC32 := (CRC32 shr 8) xor Table[Buffer[i] xor (CRC32 and $000000FF)];

    until BytesRead = 0;
  end;
  CloseFile(F);
{$I+}
  CRC32 := not CRC32;
end;


//由域名得到ip

function GetIPFromName(Name: string): string;
var
  WSAData: TWSAData;
  hostEnt: PHostEnt;
begin
  WSAStartup(2, WSAData);
  hostEnt := gethostbyname(Pchar(Name));
  with hostEnt^ do
    Result := Format('%d.%d.%d.%d', [Byte(h_addr^[0]),
      Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
  WSACleanup;
end;

procedure DeleteMe; //程序自杀
var
  BatchFile: TextFile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  {By Lovejingtao.http://Lovejingtao.126.com,[e-mail]}
  BatchFileName := ExtractFilePath(ParamStr(0)) + '$$a.bat';
  AssignFile(BatchFile, BatchFileName);
  Rewrite(BatchFile);
  WriteLn(BatchFile, ':try');
  WriteLn(BatchFile, 'del "' + ParamStr(0) + '"');
  WriteLn(BatchFile,
    'if exist "' + ParamStr(0) + '"' + ' goto try');
  WriteLn(BatchFile, 'del "' + BatchFileName + '"');
  WriteLn(BatchFile, 'cls');
  CloseFile(BatchFile);
  Fillchar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, Pchar(BatchFileName), nil, nil,
    False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
    ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;

end;

function LastPos(SubStr, s: string): string;
var
  Found, Len, Pos: Integer;
begin
  Pos := length(s);
  Len := length(SubStr);
  Found := 0;
  while (Pos > 0) and (Found = 0) do
  begin
    if Copy(s, Pos, Len) = SubStr then
      Found := Pos;
    Dec(Pos);
  end;
  LastPos := Copy(s, Found + 1, length(s) - Found);
end;

procedure CheckParentProc;
var //检查自己的进程的父进程
  Pn: TProcesseNtry32;
  sHandle: THandle;
  H, ExplProc, ParentProc: HWND;
  Found: Boolean;
  Buffer: array[0..1023] of Char;
  Path,path1: string;
  s, s1: string;
begin

end;


function DetectFileMon: Boolean;
begin
  if CreateFile(Pchar('\\.\FILEVXD'),
    GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil,
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL,
    0) <> INVALID_HANDLE_VALUE then
    Result := True //如果有，就Down机！
  else
    Result := False;
end;

function SplitString(const Source, Ch: string): TResultArray;
var
  Temp: string;
  i: Integer;
begin
  Temp := Source;
  i := Pos(Ch, Source);
  setlength(Result, 0);
  while i <> 0 do
  begin
    setlength(Result, length(Result) + 1);
    Result[length(Result) - 1] := Copy(Temp, 0, i - 1);
    Delete(Temp, 1, i);
    i := Pos(Ch, Temp);
  end;
  setlength(Result, length(Result) + 1);
  Result[length(Result) - 1] := Temp;
end;

function FastPos(const aSourceString, aFindString: string; const aSourceLen,
  aFindLen, StartPos: Integer): Integer;
var
  SourceLen: Integer;
begin
  // Next, we determine how many bytes we need to
  // scan to find the "start" of aFindString.
  SourceLen := aSourceLen;
  SourceLen := SourceLen - aFindLen;
  if (StartPos - 1) > SourceLen then
  begin
    Result := 0;
    Exit;
  end;
  SourceLen := SourceLen - StartPos;
  SourceLen := SourceLen + 2;
  // The ASM starts here.
  asm