干了不一定成功,但至少为下一次冲击积累了经验,不干永远没出息.

发布新日志

  • delphi Md5

    2008-12-07 20:03:46

    //http://hi.baidu.com/coolcat197/blog/item/e98b63d9f746a0e939012ffa.html

    //DELPHI MD5加密算法2007-01-23 02:38具体使用方法如下,另外还附有源代码:

    {-----------------------------------------------------------

    1、 MD5String、MD5File、MD5Print、MD5Match这四个函数是供调用的。
        其他是用来辅助这几个函数的子函数。
    2、MD5String为加密字符串。
    3、MD5File为加密这个文件。
    4、MD5Print是将加密后的密文转换成字符串。
    5、MD5Match是用来比较密文是否一致。
    ExitProcess(0);
    Application.Terminate;
    加密字符串aaa MD5String('aaa')

    将加密后的aaa显示出来 MD5Print(MD5String('aaa'))

    比较两次密文是否一致: MD5Match(MD5String('第一次明文')
                          MD5String('第二次输入的明文'))

      edit2.Text:=MD5Print(MD5String(TempString));

    ------------------------------------------------------------}

    //MD5加密算法(DELPHI)

    unit md5;


    // -----------------------------------------------------------------------------------------------
    interface
    // -----------------------------------------------------------------------------------------------

    uses
    Windows;

    type
    MD5Count = array[0..1] of DWORD;
    MD5State = array[0..3] of DWORD;
    MD5Block = array[0..15] of DWORD;
    MD5CBits = array[0..7] of byte;
    MD5Digest = array[0..15] of byte;
    MD5Buffer = array[0..63] of byte;
    MD5Context = record
    State: MD5State;
    Count: MD5Count;
    Buffer: MD5Buffer;
    end;

    procedure MD5Init(var Context: MD5Context);
    procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
    procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);

    function MD5String(M: string): MD5Digest;
    function MD5File(N: string): MD5Digest;
    function MD5Print(D: MD5Digest): string;

    function MD5Match(D1, D2: MD5Digest): boolean;

    // -----------------------------------------------------------------------------------------------
    IMPLEMENTATION
    // -----------------------------------------------------------------------------------------------

    var
    PADDING: MD5Buffer = (
    $80, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00
    );

    function F(x, y, z: DWORD): DWORD;
    begin
    Result := (x and y) or ((not x) and z);
    end;

    function G(x, y, z: DWORD): DWORD;
    begin
    Result := (x and z) or (y and (not z));
    end;

    function H(x, y, z: DWORD): DWORD;
    begin
    Result := x xor y xor z;
    end;

    function I(x, y, z: DWORD): DWORD;
    begin
    Result := y xor (x or (not z));
    end;

    procedure rot(var x: DWORD; n: BYTE);
    begin
    x := (x shl n) or (x shr (32 - n));
    end;

    procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
    begin
    inc(a, F(b, c, d) + x + ac);
    rot(a, s);
    inc(a, b);
    end;

    procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
    begin
    inc(a, G(b, c, d) + x + ac);
    rot(a, s);
    inc(a, b);
    end;

    procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
    begin
    inc(a, H(b, c, d) + x + ac);
    rot(a, s);
    inc(a, b);
    end;

    procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
    begin
    inc(a, I(b, c, d) + x + ac);
    rot(a, s);
    inc(a, b);
    end;

    // -----------------------------------------------------------------------------------------------

    // Encode Count bytes at Source into (Count / 4) DWORDs at Target
    procedure Encode(Source, Target: pointer; Count: longword);
    var
    S: PByte;
    T: PDWORD;
    I: longword;
    begin
    S := Source;
    T := Target;
    for I := 1 to Count div 4 do begin
    T^ := S^;
    inc(S);
    T^ := T^ or (S^ shl 8);
    inc(S);
    T^ := T^ or (S^ shl 16);
    inc(S);
    T^ := T^ or (S^ shl 24);
    inc(S);
    inc(T);
    end;
    end;

    // Decode Count DWORDs at Source into (Count * 4) Bytes at Target
    procedure Decode(Source, Target: pointer; Count: longword);
    var
    S: PDWORD;
    T: PByte;
    I: longword;
    begin
    S := Source;
    T := Target;
    for I := 1 to Count do begin
    T^ := S^ and $ff;
    inc(T);
    T^ := (S^ shr 8) and $ff;
    inc(T);
    T^ := (S^ shr 16) and $ff;
    inc(T);
    T^ := (S^ shr 24) and $ff;
    inc(T);
    inc(S);
    end;
    end;

    // Transform State according to first 64 bytes at Buffer
    procedure Transform(Buffer: pointer; var State: MD5State);
    var
    a, b, c, d: DWORD;
    Block: MD5Block;
    begin
    Encode(Buffer, @Block, 64);
    a := State[0];
    b := State[1];
    c := State[2];
    d := State[3];
    FF (a, b, c, d, Block[ 0], 7, $d76aa478);
    FF (d, a, b, c, Block[ 1], 12, $e8c7b756);
    FF (c, d, a, b, Block[ 2], 17, $242070db);
    FF (b, c, d, a, Block[ 3], 22, $c1bdceee);
    FF (a, b, c, d, Block[ 4], 7, $f57c0faf);
    FF (d, a, b, c, Block[ 5], 12, $4787c62a);
    FF (c, d, a, b, Block[ 6], 17, $a8304613);
    FF (b, c, d, a, Block[ 7], 22, $fd469501);
    FF (a, b, c, d, Block[ 8], 7, $698098d8);
    FF (d, a, b, c, Block[ 9], 12, $8b44f7af);
    FF (c, d, a, b, Block[10], 17, $ffff5bb1);
    FF (b, c, d, a, Block[11], 22, $895cd7be);
    FF (a, b, c, d, Block[12], 7, $6b901122);
    FF (d, a, b, c, Block[13], 12, $fd987193);
    FF (c, d, a, b, Block[14], 17, $a679438e);
    FF (b, c, d, a, Block[15], 22, $49b40821);
    GG (a, b, c, d, Block[ 1], 5, $f61e2562);
    GG (d, a, b, c, Block[ 6], 9, $c040b340);
    GG (c, d, a, b, Block[11], 14, $265e5a51);
    GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa);
    GG (a, b, c, d, Block[ 5], 5, $d62f105d);
    GG (d, a, b, c, Block[10], 9, $2441453);
    GG (c, d, a, b, Block[15], 14, $d8a1e681);
    GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8);
    GG (a, b, c, d, Block[ 9], 5, $21e1cde6);
    GG (d, a, b, c, Block[14], 9, $c33707d6);
    GG (c, d, a, b, Block[ 3], 14, $f4d50d87);
    GG (b, c, d, a, Block[ 8], 20, $455a14ed);
    GG (a, b, c, d, Block[13], 5, $a9e3e905);
    GG (d, a, b, c, Block[ 2], 9, $fcefa3f8);
    GG (c, d, a, b, Block[ 7], 14, $676f02d9);
    GG (b, c, d, a, Block[12], 20, $8d2a4c8a);
    HH (a, b, c, d, Block[ 5], 4, $fffa3942);
    HH (d, a, b, c, Block[ 8], 11, $8771f681);
    HH (c, d, a, b, Block[11], 16, $6d9d6122);
    HH (b, c, d, a, Block[14], 23, $fde5380c);
    HH (a, b, c, d, Block[ 1], 4, $a4beea44);
    HH (d, a, b, c, Block[ 4], 11, $4bdecfa9);
    HH (c, d, a, b, Block[ 7], 16, $f6bb4b60);
    HH (b, c, d, a, Block[10], 23, $bebfbc70);
    HH (a, b, c, d, Block[13], 4, $289b7ec6);
    HH (d, a, b, c, Block[ 0], 11, $eaa127fa);
    HH (c, d, a, b, Block[ 3], 16, $d4ef3085);
    HH (b, c, d, a, Block[ 6], 23, $4881d05);
    HH (a, b, c, d, Block[ 9], 4, $d9d4d039);
    HH (d, a, b, c, Block[12], 11, $e6db99e5);
    HH (c, d, a, b, Block[15], 16, $1fa27cf8);
    HH (b, c, d, a, Block[ 2], 23, $c4ac5665);
    II (a, b, c, d, Block[ 0], 6, $f4292244);
    II (d, a, b, c, Block[ 7], 10, $432aff97);
    II (c, d, a, b, Block[14], 15, $ab9423a7);
    II (b, c, d, a, Block[ 5], 21, $fc93a039);
    II (a, b, c, d, Block[12], 6, $655b59c3);
    II (d, a, b, c, Block[ 3], 10, $8f0ccc92);
    II (c, d, a, b, Block[10], 15, $ffeff47d);
    II (b, c, d, a, Block[ 1], 21, $85845dd1);
    II (a, b, c, d, Block[ 8], 6, $6fa87e4f);
    II (d, a, b, c, Block[15], 10, $fe2ce6e0);
    II (c, d, a, b, Block[ 6], 15, $a3014314);
    II (b, c, d, a, Block[13], 21, $4e0811a1);
    II (a, b, c, d, Block[ 4], 6, $f7537e82);
    II (d, a, b, c, Block[11], 10, $bd3af235);
    II (c, d, a, b, Block[ 2], 15, $2ad7d2bb);
    II (b, c, d, a, Block[ 9], 21, $eb86d391);
    inc(State[0], a);
    inc(State[1], b);
    inc(State[2], c);
    inc(State[3], d);
    end;

    // -----------------------------------------------------------------------------------------------

    // Initialize given Context
    procedure MD5Init(var Context: MD5Context);
    begin
    with Context do begin
    State[0] := $67452301;
    State[1] := $efcdab89;
    State[2] := $98badcfe;
    State[3] := $10325476;
    Count[0] := 0;
    Count[1] := 0;
    ZeroMemory(@Buffer, SizeOf(MD5Buffer));
    end;
    end;

    // Update given Context to include Length bytes of Input
    procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
    var
    Index: longword;
    PartLen: longword;
    I: longword;
    begin
    with Context do begin
    Index := (Count[0] shr 3) and $3f;
    inc(Count[0], Length shl 3);
    if Count[0] < (Length shl 3) then inc(Count[1]);
    inc(Count[1], Length shr 29);
    end;
    PartLen := 64 - Index;
    if Length >= PartLen then begin
    CopyMemory(@Context.Buffer[Index], Input, PartLen);
    Transform(@Context.Buffer, Context.State);
    I := PartLen;
    while I + 63 < Length do begin
    Transform(@Input[I], Context.State);
    inc(I, 64);
    end;
    Index := 0;
    end else I := 0;
    CopyMemory(@Context.Buffer[Index], @Input[I], Length - I);
    end;

    // Finalize given Context, create Digest and zeroize Context
    procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
    var
    Bits: MD5CBits;
    Index: longword;
    PadLen: longword;
    begin
    Decode(@Context.Count, @Bits, 2);
    Index := (Context.Count[0] shr 3) and $3f;
    if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
    MD5Update(Context, @PADDING, PadLen);
    MD5Update(Context, @Bits, 8);
    Decode(@Context.State, @Digest, 4);
    ZeroMemory(@Context, SizeOf(MD5Context));
    end;

    // -----------------------------------------------------------------------------------------------

    // Create digest of given Message
    function MD5String(M: string): MD5Digest;
    var
    Context: MD5Context;
    begin
    MD5Init(Context);
    MD5Update(Context, pChar(M), length(M));
    MD5Final(Context, Result);
    end;

    // Create digest of file with given Name
    function MD5File(N: string): MD5Digest;
    var
    FileHandle: THandle;
    MapHandle: THandle;
    ViewPointer: pointer;
    Context: MD5Context;
    begin
    MD5Init(Context);
    FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
    if FileHandle <> INVALID_HANDLE_value then try
    MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
    if MapHandle <> 0 then try
    ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
    if ViewPointer <> nil then try
    MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
    finally
    UnmapViewOfFile(ViewPointer);
    end;
    finally
    CloseHandle(MapHandle);
    end;
    finally
    CloseHandle(FileHandle);
    end;
    MD5Final(Context, Result);
    end;

    // Create hex representation of given Digest
    function MD5Print(D: MD5Digest): string;
    var
    I: byte;
    const
    Digits: array[0..15] of char =
    ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
    begin
    Result := '';
    for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f];
    end;

    // -----------------------------------------------------------------------------------------------

    // Compare two Digests
    function MD5Match(D1, D2: MD5Digest): boolean;
    var
    I: byte;
    begin
    I := 0;
    Result := TRUE;
    while Result and (I < 16) do begin
    Result := D1[I] = D2[I];
    inc(I);
    end;
    end;

    end.

  • Delphi XM

    2008-12-07 19:46:07

    {
      MiniFMOD 1.7 is a free C library from Fairlight
      Technologies (http://www.fmod.org) which allows
      you to play .XM files. Compiled into a .OBJ,
      it is then possible to use it in any language
      that supports OMF .OBJ files.

      Here is the Delphi header I made for it.

      Twis (June 2004).
    }

    unit MiniFMOD;

    interface

    uses
      Windows;

    type
      TMemoryFile = record
        Length: Cardinal;
        Position: Cardinal;
        Data: Pointer;
      end;
      PMemoryFile = ^TMemoryFile;
      PMUSICMODULE = Pointer;

    const
      // this is for the callbacks
      SEEK_SET = 0;
      SEEK_CUR = 1;
      SEEK_END = 2;

    var
      Module: PMUSICMODULE = nil;
      _ResName, _ResType: PChar;
      __turboFloat: Integer;

    // functions from MiniFMOD

    procedure _FSOUND_File_SetCallbacks(OpenCallback, CloseCallback, ReadCallback, SeekCallback, TellCallback: Pointer); cdecl;
    function _FMUSIC_LoadSong(Name: PChar; SampleLoadCallback: Pointer): PMUSICMODULE; cdecl;
    function _FMUSIC_FreeSong(Module: PMUSICMODULE): ByteBool; cdecl;
    function _FMUSIC_PlaySong(Module: PMUSICMODULE): ByteBool; cdecl;
    function _FMUSIC_StopSong(Module: PMUSICMODULE): ByteBool; cdecl;
    function _FMUSIC_GetOrder(Module: PMUSICMODULE): Integer; cdecl;
    function _FMUSIC_GetRow(Module: PMUSICMODULE): Integer; cdecl;
    function _FMUSIC_GetTime(Module: PMUSICMODULE): Cardinal; cdecl;

    // functions I added

    procedure XMPlayFromRes(ResName, ResType: PChar);
    procedure XMFree();
                                           
    implementation

    {$L MiniFMOD.obj}

    {
      C functions which are not included in the .OBJ, so
      we need to reprogram them here.
    }

    function _memcpy(Destination: Pointer; Source: Pointer; Count: Cardinal): Pointer; cdecl;
    begin
      CopyMemory(Destination, Source, Count);
      Result := Destination;
    end;

    function _memset(Destination: Pointer; C: Integer; Count: Cardinal): Pointer; cdecl;
    begin
      FillMemory(Destination, Count, C);
      Result := Destination;
    end;

    function _calloc(Number: Cardinal; Size: Cardinal): Pointer; cdecl;
    begin
      GetMem(Result, Number * Size);
      ZeroMemory(Result, Number * Size);
    end;

    procedure _free(Block: Pointer); cdecl;
    begin
      FreeMem(Block);
    end;

    procedure __ftol;
    asm
      push          eax
      fistp         dword ptr [esp]
      fwait
      pop           eax
    end;

    procedure _fabs;
    asm
      fld           qword ptr [esp + 4]
      fabs
      fwait
    end;

    procedure _sin;
    asm
      fld           qword ptr [esp + 4]
      fsin
      fwait
    end;

    procedure _abs;
    asm
      mov           eax, dword ptr [esp + 4]
      test          eax, $80000000
      jz            @Exit
      neg           eax
      @Exit:
    end;

    procedure _pow;
    asm
      fld           qword ptr [esp + 12]
      fld           qword ptr [esp + 4]
      fyl2x
      fld           ST(0)
      frndint
      fsub          ST(1), ST
      fxch          ST(1)
      f2xm1
      fld1
      fadd
      fscale
      fstp          ST(1)
      fwait
    end;

    {
      here comes the callback functions when playing from a resource
    }

    function MemFile_OpenCallback(Name: PChar): PMemoryFile; cdecl;
    var
      ResParam: HRSRC;
      ResHandle: HGLOBAL;
    begin
      New(Result);
      ResParam := FindResource(hInstance, Name, _ResType);
      ResHandle := LoadResource(hInstance, ResParam);
      Result.Length := SizeOfResource(hInstance, ResParam);
      Result.Data := LockResource(ResHandle);
      Result.Position := 0;
    end;

    procedure MemFile_CloseCallback(MemFile: PMemoryFile); cdecl;
    begin
      Dispose(MemFile);
    end;

    function MemFile_ReadCallback(Buffer: Pointer; Size: Cardinal; MemFile: PMemoryFile): Integer; cdecl;
    begin
      if MemFile.Position + Size >= MemFile.Length then
        Size := MemFile.Length - MemFile.Position;
      CopyMemory(Buffer, Pointer(Cardinal(MemFile.Data) + MemFile.Position), Size);
      MemFile.Position := MemFile.Position + Size;
      Result := Size;
    end;

    procedure MemFile_SeekCallback(MemFile: PMemoryFile; Position: Integer; Mode: Byte); cdecl;
    begin
      case Mode of
        SEEK_SET: MemFile.Position := Position;
        SEEK_CUR: MemFile.Position := Integer(MemFile.Position) + Position;
        SEEK_END: MemFile.Position := Integer(MemFile.Length) + Position;
      end;
      if MemFile.Position > MemFile.Length then
        MemFile.Position := MemFile.Length;
    end;

    function MemFile_TellCallback(MemFile: PMemoryFile): Integer; cdecl;
    begin
      Result := MemFile.Position;
    end;

    {
      some imports (waveout API)
    }

    function waveOutOpen: DWORD; stdcall; external 'winmm.dll';
    function waveOutClose: DWORD; stdcall; external 'winmm.dll';
    function waveOutPrepareHeader: DWORD; stdcall; external 'winmm.dll';
    function waveOutUnprepareHeader: DWORD; stdcall; external 'winmm.dll';
    function waveOutWrite: DWORD; stdcall; external 'winmm.dll';
    function waveOutReset: DWORD; stdcall; external 'winmm.dll';
    function waveOutGetPosition: DWORD; stdcall; external 'winmm.dll';

    {
      functions from MiniFMOD
    }

    procedure _FSOUND_File_SetCallbacks; external;
    function _FMUSIC_LoadSong; external;
    function _FMUSIC_FreeSong; external;
    function _FMUSIC_PlaySong; external;
    function _FMUSIC_StopSong; external;
    function _FMUSIC_GetOrder; external;
    function _FMUSIC_GetRow; external;
    function _FMUSIC_GetTime; external;

    {
      here we go with the functions we will use
      from outside this unit
    }

    procedure XMPlayFromRes(ResName, ResType: PChar);
    begin
      if Module <> nil then Exit;
      _ResName := ResName;
      _ResType := ResType;
      _FSOUND_File_SetCallbacks(@MemFile_OpenCallback, @MemFile_CloseCallback,
        @MemFile_ReadCallback, @MemFile_SeekCallback, @MemFile_TellCallback);
      Module := _FMUSIC_LoadSong(ResName, nil);
      _FMUSIC_PlaySong(Module);
    end;

    procedure XMFree();
    begin
      _FMUSIC_FreeSong(Module);
      Module := nil;
    end;

    end.

我的栏目

我的存档

数据统计

  • 访问量: 1832
  • 日志数: 3
  • 建立时间: 2008-12-06
  • 更新时间: 2008-12-19

RSS订阅

Open Toolbar