如何让程序只能在一台机器上运行。(序列号)。如成功可再加分

我也没有做过,不过我感觉就是通过这个CPUID号码使用某种算法计算一个序列号就对了,这个计算程序当然只有你自己有啦.然后就在程序中的适当位置加入检查注册的程序咯.

一般都用硬盘序例号：//获取硬盘序列号
//win98要 c:\windows\system\的smartvsd.vxd
//copy to c:\windows\system\iosubsys
//reboot your computer and ok
//2000 and nt do not need
function GetIdeSerialNumber: String;
const
  IDENTIFY_BUFFER_SIZE = 512;
type
   TIDERegs = packed record
    bFeaturesReg     : BYTE; // Used for specifying SMART "commands".
    bSectorCountReg  : BYTE; // IDE sector count register
    bSectorNumberReg : BYTE; // IDE sector number register
    bCylLowReg       : BYTE; // IDE low order cylinder value
    bCylHighReg      : BYTE; // IDE high order cylinder value
    bDriveHeadReg    : BYTE; // IDE drive/head register
    bCommandReg      : BYTE; // Actual IDE command.
    bReserved        : BYTE; // reserved for future use.  Must be zero.
  end;
  TSendCmdInParams = packed record
    // Buffer size in bytes
    cBufferSize  : DWORD;
    // Structure with drive register values.
    irDriveRegs  : TIDERegs;
    // Physical drive number to send command to (0,1,2,3).
    bDriveNumber : BYTE;
    bReserved    : Array[0..2] of Byte;
    dwReserved   : Array[0..3] of DWORD;
    bBuffer      : Array[0..0] of Byte;  // Input buffer.
  end;
  TIdSector = packed record
    wGenConfig                 : Word;
    wNumCyls                   : Word;
    wReserved                  : Word;
    wNumHeads                  : Word;
    wBytesPerTrack             : Word;
    wBytesPerSector            : Word;
    wSectorsPerTrack           : Word;
    wVendorUnique              : Array[0..2] of Word;
    sSerialNumber              : Array[0..19] of CHAR;
    wBufferType                : Word;
    wBufferSize                : Word;
    wECCSize                   : Word;
    sFirmwareRev               : Array[0..7] of Char;
    sModelNumber               : Array[0..39] of Char;
    wMoreVendorUnique          : Word;
    wDoubleWordIO              : Word;
    wCapabilities              : Word;
    wReserved1                 : Word;
    wPIOTiming                 : Word;
    wDMATiming                 : Word;
    wBS                        : Word;
    wNumCurrentCyls            : Word;
    wNumCurrentHeads           : Word;
    wNumCurrentSectorsPerTrack : Word;
    ulCurrentSectorCapacity    : DWORD;
    wMultSectorStuff           : Word;
    ulTotalAddressableSectors  : DWORD;
    wSingleWordDMA             : Word;
    wMultiWordDMA              : Word;
    bReserved                  : Array[0..127] of BYTE;
  end;
  PIdSector = ^TIdSector;
  TDriverStatus = packed record
    // 驱动器返回的错误代码，无错则返回0
    bDriverError : Byte;
    // IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
    bIDEStatus   : Byte;
    bReserved    : Array[0..1] of Byte;
    dwReserved   : Array[0..1] of DWORD;
  end;
  TSendCmdOutParams = packed record
    // bBuffer的大小
    cBufferSize  : DWORD;
    // 驱动器状态
    DriverStatus : TDriverStatus;
    // 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
    bBuffer      : Array[0..0] of BYTE;
  end;
var
  hDevice : THandle;
  cbBytesReturned : DWORD;
  ptr : PChar;
  SCIP : TSendCmdInParams;
  aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
  IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;  procedure ChangeByteOrder( var Data; Size : Integer );
  var ptr : PChar;
      i : Integer;
      c : Char;
  begin
    ptr := @Data;
    for i := 0 to (Size shr 1)-1 do begin
      c := ptr^;
      ptr^ := (ptr+1)^;
      (ptr+1)^ := c;
      Inc(ptr,2);
    end;
end;begin
  Result := ''; // 如果出错则返回空串
  if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then begin// Windows NT, Windows 2000
      // 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '\\.\PhysicalDrive1\'
      hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
  end else // Version Windows 95 OSR2, Windows 98
    hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
    if hDevice=INVALID_HANDLE_VALUE then Exit;
   try
    FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
    FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
    cbBytesReturned := 0;
    // Set up data structures for IDENTIFY command.
    with SCIP do begin
      cBufferSize  := IDENTIFY_BUFFER_SIZE;
      //bDriveNumber := 0;
      with irDriveRegs do begin
        bSectorCountReg  := 1;
        bSectorNumberReg := 1;
        //if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
        //else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
        bDriveHeadReg    := $A0;
        bCommandReg      := $EC;
      end;
    end;
    if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
      @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
  finally
    CloseHandle(hDevice);
  end;
  with PIdSector(@IdOutCmd.bBuffer)^ do begin
    ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
    (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
    ptr := PChar(@sSerialNumber);
    Result := Trim(ptr);
  end;
end;

还有你Search一下，有许多类似贴子

function GetIdeSerialNumber: pchar;
  const IDENTIFY_BUFFER_SIZE = 512;
type
   TIDERegs = packed record
     bFeaturesReg: BYTE; // Used for specifying SMART "commands".
     bSectorCountReg: BYTE; // IDE sector count register
     bSectorNumberReg: BYTE; // IDE sector number register
     bCylLowReg: BYTE; // IDE low order cylinder value
     bCylHighReg: BYTE; // IDE high order cylinder value
     bDriveHeadReg: BYTE; // IDE drive/head register
     bCommandReg: BYTE; // Actual IDE command.
     bReserved: BYTE; // reserved for future use. Must be zero.
  end;
  TSendCmdInParams = packed record
    // Buffer size in bytes
    cBufferSize: DWORD;
    // Structure with drive register values.
    irDriveRegs: TIDERegs;
    // Physical drive number to send command to (0,1,2,3).
    bDriveNumber: BYTE;
    bReserved: array[0..2] of Byte;
    dwReserved: array[0..3] of DWORD;
    bBuffer: array[0..0] of Byte; // Input buffer.
  end;
  TIdSector = packed record
    wGenConfig: Word;
    wNumCyls: Word;
    wReserved: Word;
    wNumHeads: Word;
    wBytesPerTrack: Word;
    wBytesPerSector: Word;
    wSectorsPerTrack: Word;
    wVendorUnique: array[0..2] of Word;
    sSerialNumber: array[0..19] of CHAR;
    wBufferType: Word;
    wBufferSize: Word;
    wECCSize: Word;
    sFirmwareRev: array[0..7] of Char;
    sModelNumber: array[0..39] of Char;
    wMoreVendorUnique: Word;
    wDoubleWordIO: Word;
    wCapabilities: Word;
    wReserved1: Word;
    wPIOTiming: Word;
    wDMATiming: Word;
    wBS: Word;
    wNumCurrentCyls: Word;
    wNumCurrentHeads: Word;
    wNumCurrentSectorsPerTrack: Word;
    ulCurrentSectorCapacity: DWORD;
    wMultSectorStuff: Word;
    ulTotalAddressableSectors: DWORD;
    wSingleWordDMA: Word;
    wMultiWordDMA: Word;
    bReserved: array[0..127] of BYTE;
  end;
  PIdSector = ^TIdSector;
  TDriverStatus = packed record
    // 驱动器返回的错误代码，无错则返回0
    bDriverError: Byte;
    // IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
    bIDEStatus: Byte;
    bReserved: array[0..1] of Byte;
    dwReserved: array[0..1] of DWORD;
  end;
  TSendCmdOutParams = packed record
    // bBuffer的大小
    cBufferSize: DWORD;
    // 驱动器状态
    DriverStatus: TDriverStatus;
    // 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
    bBuffer: array[0..0] of BYTE;
  end;
var
  hDevice: Thandle;
  cbBytesReturned: DWORD;
  SCIP: TSendCmdInParams;
  aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
  IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;
procedure ChangeByteOrder(var Data; Size: Integer);
var
  ptr: Pchar;
  i: Integer;
  c: Char;
begin
  ptr := @Data;
  for I := 0 to (Size shr 1) - 1 do begin
    c := ptr^;
    ptr^ := (ptr + 1)^;
    (ptr + 1)^ := c;
    Inc(ptr, 2);
  end;
end;
begin
Result := ''; // 如果出错则返回空串
if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then begin // Windows NT, Windows 2000
// 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '\\.\PhysicalDrive1\'
hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
end else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);
if hDevice = INVALID_HANDLE_VALUE then Exit;
try
FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
cbBytesReturned := 0;
// Set up data structures for IDENTIFY command.
with SCIP do begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
// bDriveNumber := 0;
with irDriveRegs do begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
bDriveHeadReg := $A0;
bCommandReg := $EC;
end;
end;
if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,
@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit;
finally
CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do begin
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;
Result := Pchar(@sSerialNumber);
end;
end;//调用方法
procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text:=strpas(GetIdeSerialNumber);
end;

如果要加密么把CPU的也给你不过有汇编:
FUNCTION GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD       {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI       {Restore registers}
  POP     EBX
END;function GetCPUIDStr:String;
var
  CPUID:TCPUID;
begin
  CPUID:=GetCPUID;
  Result:=IntToHex(CPUID[1],8)+IntToHex(CPUID[2],8)+IntToHex(CPUID[3],8)+IntToHex(CPUID[4],8);
end;

type
TCPUID= array[1..4] of Longint;调用的使用加上这个。上面给你的是取出厂系列号的。格式化以后系列还是那个.不过相同信号的硬盘系列号相同.相同信号的CPUID一样.所以你在分发软件的时候考虑增加一个随机值.放到keyfile里.读的时候三者一起用.

下面的程序是把CPU和硬盘系列号一起生成系列号(我只是给你一个例子你要用其它的也行):
function GetID:String;
var
  Str:String;
  LenIDNmuber,i:Integer;
  a,sum:LongWord;
begin
sum:=0;
Str:=strpas(GetIdeSerialNumber)+GetCPUIDStr;
LenIDNmuber:=Length(Str);
if LenIDNmuber>0 then
  begin
    for i:=1 to LenIDNmuber do
      begin
        a:=ord(Str[i]) shl $11;
        sum:=sum+a;
      end;
    result:=IntToStr(sum);
  end;
end;

TCUPID是包含在什么单元中的？显示未定义

你把这个加上:
type
TCPUID= array[1..4] of Longint;

你在使用的时候可以判断啊.如果取到文件的值为空或者不是你给的那值就不执行程序嘛.
呵呵。你还可以写到EXE文件空隙里去的.

type
TCPUID= array[1..4] of Longint;调用的使用加上这个。上面给你的是取出厂系列号的。格式化以后系列还是那个.不过相同信号的硬盘系列号相同.相同信号的CPUID一样.所以你在分发软件的时候考虑增加一个随机值.放到keyfile里.读的时候三者一起用.

就写在EXE中，放到数据库里，别人可能到数据库中改CONST ID = 'WFWFEFWEF'IF ID <> GETHARDDISKID THEN BEIGN
EXIT ;
END ;

取序列号(CPU,硬盘，网卡)控件下载:
Http://www.datcn.com/downloads/hardwareinfo.exe

现金我是不明白怎么才能在EXE文件生成后，将变量写入到文件中呢？

最好还是软件狗的http://lysoft.7u7.net

同意ly_liuyang(Liu Yang) 意见
如果商家说原来那台机器坏了，重新装另外一台，难度你还收别人的钱。你没有办法认定别人是不是说的是真的。千万别给自己找事。
我现在是干脆不管了，要注册码给。
软件狗简单。

唉.想来想去,花了一天时间验证...........有下面的解决方法:
首先做一个程序往硬盘的间隙空间写一个初始值..下面有用.
使用上面我给你的代码生成系列号(其实也不需要。只要生成一个随机的系列号就可以),然后开始进行加密部分也就是注册码比较部分(这里我就不多说了。要例子源码的话去这里下载:http://www.ksaiy.com下载),在进行比较的时候先对刚刚写入到硬盘间隙空间的初始进行判断,如果是等于初始值的话在来进行注册比较,如果为空的话。那么这个程序已经不在你指定的计算机上了.执行你需要的操作.如果不等于初始值,那看是否是注册成功后往间隙空间写的一个值,如果不是。那么也执行你的不对的操作.
软件注册成功以后要往间隙空间写一个值.对了要进行加密.
这样的话.如果拿到另外的计算机里。由于间隙空间没有值,这样的话就不能使用软件了。
这个值可以逃过Ghost....
写了那多.也不知道你能不能看懂?

是啊。现在这些号我是可以取出来了，但是后面的一些步骤我不知道该如何进行，希望各位大侠给点帮助。
谢了。问题解决马上发分。
如果分不够还可以再加。to ksaiy(消失在人海):
我会开新贴，谢谢你的帮助，再给你加分。谢谢。请继续

好的。我给你贴出代码来:
procedure TKenFrm.FormCreate(Sender: TObject);
var
  Reg:TRegistry;
  RInt,SizeInt:Integer;
  FileStr,UNStr,SNStr,RStr1,RStr2:String;
  SumInt:Integer;
  Str:String;
  DllCrcStr,DllStr:String;
begin
  Reg:=TRegistry.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  DllCrCStr:='E8A316E366BC9B7C'; //这个是加过壳的dll的CRC校验值,进行了Des加密.
  DllStr:=ExtractFilePath(Application.ExeName)+'\Ken.dll';
  if ShlStr(FileCrc32(DllStr))<>ShlStr(KDD(DllCrCStr,'wwwksaiycom')) then//校验dll失败后关闭计算机.
//    WinExit(EWX_SHUTDOWN or EWX_POWEROFF);//关机函数;调试的时候把这行注释掉，发布的时候激活此行。
    ShowMessage('校验失败！');
{
下面给出方法：
首先把自己的软件调试好以后，用FileCrc32取得主程序的CRC校验值，在对这个校验值进行加密，然后把密加结果存放到一个文
件里（这里我是举例说明，你也可以把它写到可执行文件里去，源码可以到我们的站点上下载），那么在文件的create事件里用
FileCrc32取得当前文件的CRC值，再把您存放在文件里的CRC值取出来解密后进行比较，如果正确那么就执行文件，如果不正确
就执行你自己的操作，比如关闭计算机。
这里我只是提供了方法
}  Anti_DeDe();//检测DeDe;

  SumInt:=0;
  Edit2.Text:=GetHDID;//取得系列号，每台计算机的系列号是唯一的；
  //Anti-Debug;
  if IsSoftIce95Loaded or IsSoftIceNTLoaded or IsTRWLoaded or IsTRWLoaded or IsTRW2000Loaded or IsRegMONLoaded or IsFileMONLoaded or IsBW2000Loaded then
    begin
      PostMessage(Application.Handle,WM_CLOSE,0,0);//这里是指当发现调试工具的时候关闭程序本身，也可以设置为关闭计算机；
    end;
  //程序自校验；
//  RInt:=160000;//加壳后的文件大小，壳在压缩包里提供了FSG壳，这个文件的大小你可以加壳后来进行修改，然后在编译的你的软件再加壳就可以发布了；
  //加壳方法：先打开FSG，然后选择你要加壳的文件即可。
//  FileStr:=ExpandFileName(ExtractFilePath(Application.ExeName)+'\Ken.exe');//这里写上自己的注册文件名；
//  if Anti_Self(Rint,FileStr)=True then
//    PostMessage(Application.Handle,WM_CLOSE,0,0);
  if reg.OpenKey('\SoftWare\Microsoft\KEN',True) then
    begin
      RStr1:=Reg.ReadString('UN');
      RStr2:=Reg.ReadString('SN');
    end;
  reg.CloseKey;  if (RStr1<>'') and (RStr2<>'') then
    begin
      UNStr:=KDD(RStr1,'shihongchun');
      SNStr:=KDD(RStr2,'shihongchun');
      if ShlStr(SNStr)=ShlStr(RightStr(KXEN(Edit2.Text),20)) then  //进行非明码比较；
        begin
          //下面是注册成功你要做的事情，但千万不要出现"注册成功字样"，你可以把某些功能给出来。
          Label1.Enabled:=False;
          Edit1.Enabled:=False;
          Button1.Enabled:=False;
        end
      else
        begin//对软件进行次数限制;
          if Reg.OpenKey('\SoftWare\Microsoft\KEN',True) then
              Str:=Reg.ReadString('KENC');
            Reg.CloseKey;
          if Str='' then//判断次数是否为空，如果为空那么写入1；
            begin
              if Reg.OpenKey('\SoftWare\Microsoft\KEN',True) then
                Reg.WriteString('KENC','1919F0CF019DBB3E'); //1919F0CF019DBB3E是经过加密后的字符串，原值为1；
              Reg.CloseKey;
            end
            else
            begin
            SumInt:=StrToInt(KDD(Str,'shihongchun')); //读取次数
            SumInt:=SumInt+StrToInt(KDD('1919F0CF019DBB3E','shihongchun'));//对次数进行相加；
          if SumInt>StrToInt(KDD('728DA73436100E6C','shihongchun')) then  //判断次数是否等于30次；
            begin//下面可以设置次数到期限制一些功能；
              MessageBox(KENFrm.Handle,'您好！软件的使用次数已到，请注册正式版！','注册提示',MB_OK+MB_ICONINFORMATION);
            end
          else
            begin//如果次数不到期，那么继续对次数的植进行相加；
              if Reg.OpenKey('\SoftWare\Microsoft\KEN',True) then
                Reg.WriteString('KENC',KED(IntToStr(SumInt),'shihongchun'));
                Reg.CloseKey;
            end;
          end;
        end;
    end
  else
    begin
      if Reg.OpenKey('\SoftWare\Microsoft\KEN',True) then
        Str:=Reg.ReadString('KENC');
        Reg.CloseKey;
      if Str='' then
        begin
          if Reg.OpenKey('\SoftWare\Microsoft\KEN',True) then
            Reg.WriteString('KENC','1919F0CF019DBB3E');
          Reg.CloseKey;
        end
        else
        begin
          SumInt:=StrToInt(KDD(Str,'shihongchun'));
          SumInt:=SumInt+StrToInt(KDD('1919F0CF019DBB3E','shihongchun'));
        if SumInt>StrToInt(KDD('728DA73436100E6C','shihongchun')) then
          begin
            MessageBox(KENFrm.Handle,'您好！软件的使用次数已到，请注册正式版！','注册提示',MB_OK+MB_ICONINFORMATION);
          end
        else
          begin
            if Reg.OpenKey('\SoftWare\Microsoft\KEN',True) then
              Reg.WriteString('KENC',KED(IntToStr(SumInt),'shihongchun'));
            Reg.CloseKey;
          end;
        end;
    end;
end;var
  Reg:TRegistry;
begin
  Reg:=TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  if Edit1.Text='' then
    MessageBox(KENFrm.handle,'用户名不能为空，请填写完整！','注册提示',MB_OK+MB_ICONINFORMATION)
  else
    begin
      if Edit3.Text<>'' then
        begin
          if reg.OpenKey('\SoftWare\Microsoft\KEN',True) then
            begin
              reg.WriteString('UN',KED(Edit1.Text,'shihongchun'));
              reg.WriteString('SN',KED(Edit3.Text,'shihongchun'));
            end;
          reg.CloseKey;
          MessageBox(KENFrm.handle,'请重新启动程序来进行注册码校验！','注册提示',MB_OK+MB_ICONINFORMATION);
        end
      else
        MessageBox(KENFrm.handle,'注册码不能为空，请填写完整！','注册提示',MB_OK+MB_ICONINFORMATION)
    end;

上面是你接下来要做的事情...Function ShlStr(Str1:String):String; //进行明码变换；
var
  a:LongWord;
  Int1,Int2:Integer;
  j,j1:Integer;
  sum:LongWord;
begin
    Int2:=Length(Str1);
    for j1:=1 to Int2 do
      begin
        a:=ord(Str1[j1]) shl 7;
        sum:=sum+a;
      end;
    Result:=IntToStr(sum);
end;//NT/2000/XP下关闭计算机函数
function WinExit(flags: integer): boolean;stdcall;//关闭计算机函数;
  function SetPrivilege(privilegeName: string; enable: boolean): boolean;
  var tpPrev,
      tp        : TTokenPrivileges;
      token      : THandle;
      dwRetLen  : DWord;
  begin
    result := False;
    OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, token);
    tp.PrivilegeCount := 1;
    if LookupPrivilegeValue(nil, pchar(privilegeName), tp.Privileges[0].LUID) then
    begin
      if enable then
        tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
      else
        tp.Privileges[0].Attributes := 0;
      dwRetLen := 0;
      result := AdjustTokenPrivileges(token, False, tp, SizeOf(tpPrev), tpPrev, dwRetLen);
    end;
    CloseHandle(token);
  end;
begin
  if SetPrivilege('SeShutdownPrivilege', true) then begin
    ExitWindowsEx(flags, 0);
    SetPrivilege('SeShutdownPrivilege', False)
  end;
end;{--------------------------------------------------------}
{                   Anti-Debug                           }
{                  作者：ksaiy                           }
{--------------------------------------------------------}
Procedure Anti_DeDe();//检测DEDE反编译器；
var
  DeDeHandle:THandle;
  i:integer;
begin
  DeDeHandle:=FindWindow(nil,chr($64)+chr($65)+chr($64)+chr($65));
  if DeDeHandle<>0 then
    begin
      For i:=1 to 4500 do
        SendMessage(DeDeHandle,WM_CLOSE,0,0);
    end;
end;在给你提供一个反跟踪的代码:
Function SoftIceXPLoaded:Boolean;stdcall;//检测Win2000/XP下的SoftIce
var
  :Integer;
  YesInt,NoInt:Integer;
begin
  YesInt:=0;NoInt:=0;
  :=0;
  asm
    push offset @handler
    push dword ptr fs:[0]
    mov  dword ptr fs:[0],esp
    xor  eax,eax
    int 1
    inc  eax
    inc  eax
    pop  dword ptr fs:[0]
    add esp,4
    or   eax,eax
    jz   @found
    cmp , 0
    jnz   @found
    jmp  @Nofound
    @handler:
      mov ebx,[esp+0ch]
      add dword ptr [ebx+0b8h],02h
      mov ebx,[esp+4]
      cmp [ebx], 80000004h
      jz @Table
      inc
    @Table:
      xor eax,eax
     ret
    @found:
      mov YesInt,1
    @Nofound:
      mov NoInt,1
  end;
  if Yesint=1 then
    Result:=True;
  if NoInt=1 then
    Result:=False;
end;

好了。都帖出来了。如果你需要一个这样的示例源码的话你可以去这里下载:http://www.ksaiy.com/ynen/BDelphi_Demo.asp里面包括了一整套的注册模式和注册机的例子.

////////////////////////////////////////////////////////////////////////////////
//Anti-Monitor
Function DumpLoaded: Boolean;stdcall;  //检测Dump;
var
  hFile: Thandle;
Begin
  Result:= false;
  hFile := FindWindow(nil,'ProcDump32 (C) 1998, 1999, 2000 G-RoM, Lorian & Stone');
  if( hFile <> 0 ) then
  begin
    Result:= TRUE;
  end;
End;Function RegLoaded: Boolean;stdcall;  //检测RegMON;
var
  hFile: Thandle;
Begin
  Result:= false;
  hFile := FindWindow(nil,'Registry Monitor - Sysinternals: www.sysinternals.com');
  if( hFile <> 0 ) then
  begin
    Result:= TRUE;
  end;
End;Function FileLoaded: Boolean;stdcall;  //检测FileMON;
var
  hFile: Thandle;
Begin
  Result:= false;
  hFile := FindWindow(nil,'File Monitor - Sysinternals: www.sysinternals.com');
  if( hFile <> 0 ) then
  begin
    Result:= TRUE;
  end;
End;////////////////////////////////////////////////////////////////////////////////
//Anti-loader
Function IsDebug():Boolean;stdcall; //检测调试器;
var
  YInt,NInt:Integer;
begin
  asm
    mov eax,fs:[30h]
    movzx eax,byte ptr[eax+2h]
    or al,al
    jz @No
    jnz @Yes
    @No:
      mov NInt,1
    @Yes:
      Mov YInt,1
  end;
  if YInt=1 then
    Result:=True;
  if NInt=1 then
    Result:=False;
end;////////////////////////////////////////////////////////////////////////////////
//DetectBreakpoint
Function IsBPX(addr:Pointer):Boolean;stdcall;//防范BPX断点
var
  YInt,NInt:Integer;
begin
  asm
    mov esi,addr
    mov al,[esi]
    cmp al,$CC
    je @Yes
    jne @No
    @Yes:
      mov YInt,1
    @No:
      mov NInt,1
  end;
  if YInt=1 then
    Result:=True;
  if NInt=1 then
    Result:=False;
end;
这些代码我本来都弄成商业软件的代码的。现在我都贴出来了。呵呵:)
-----------------------http://www.ksaiy.com-----------------------

还有.好多人都在找blowfish的算法源码.我就也给你贴出来了:
unit K_BL;interfacefunction BlowFish_DN(PT: int64): int64;
function BlowFish_EN(PT: int64): int64;
function BlowFish_Func(PT: LongWord): LongWord;
procedure BlowFish_Init(Key: string);const
  pBOX: array[1..18] of LongWord =
  ($243f6a88, $85a308d3, $13198a2e, $03707344, $a4093822, $299f31d0,
  $082efa98, $ec4e6c89, $452821e6, $38d01377, $be5466cf, $34e90c6c,
  $c0ac29b7, $c97c50dd, $3f84d5b5, $b5470917, $9216d5d9, $8979fb1b);
  sBox: array[1..4, 1..256] of LongWord =
  (($d1310ba6, $98dfb5ac, $2ffd72db, $d01adfb7, $b8e1afed, $6a267e96,
    $ba7c9045, $f12c7f99, $24a19947, $b3916cf7, $0801f2e2, $858efc16,
    $636920d8, $71574e69, $a458fea3, $f4933d7e, $0d95748f, $728eb658,
    $718bcd58, $82154aee, $7b54a41d, $c25a59b5, $9c30d539, $2af26013,
    $c5d1b023, $286085f0, $ca417918, $b8db38ef, $8e79dcb0, $603a180e,
    $6c9e0e8b, $b01e8a3e, $d71577c1, $bd314b27, $78af2fda, $55605c60,
    $e65525f3, $aa55ab94, $57489862, $63e81440, $55ca396a, $2aab10b6,
    $b4cc5c34, $1141e8ce, $a15486af, $7c72e993, $b3ee1411, $636fbc2a,
    $2ba9c55d, $741831f6, $ce5c3e16, $9b87931e, $afd6ba33, $6c24cf5c,
    $7a325381, $28958677, $3b8f4898, $6b4bb9af, $c4bfe81b, $66282193,
    $61d809cc, $fb21a991, $487cac60, $5dec8032, $ef845d5d, $e98575b1,
    $dc262302, $eb651b88, $23893e81, $d396acc5, $0f6d6ff3, $83f44239,
    $2e0b4482, $a4842004, $69c8f04a, $9e1f9b5e, $21c66842, $f6e96c9a,
    $670c9c61, $abd388f0, $6a51a0d2, $d8542f68, $960fa728, $ab5133a3,
    $6eef0b6c, $137a3be4, $ba3bf050, $7efb2a98, $a1f1651d, $39af0176,
    $66ca593e, $82430e88, $8cee8619, $456f9fb4, $7d84a5c3, $3b8b5ebe,
    $e06f75d8, $85c12073, $401a449f, $56c16aa6, $4ed3aa62, $363f7706,
    $1bfedf72, $429b023d, $37d0d724, $d00a1248, $db0fead3, $49f1c09b,
    $075372c9, $80991b7b, $25d479d8, $f6e8def7, $e3fe501a, $b6794c3b,
    $976ce0bd, $04c006ba, $c1a94fb6, $409f60c4, $5e5c9ec2, $196a2463,
    $68fb6faf, $3e6c53b5, $1339b2eb, $3b52ec6f, $6dfc511f, $9b30952c,
    $cc814544, $af5ebd09, $bee3d004, $de334afd, $660f2807, $192e4bb3,
    $c0cba857, $45c8740f, $d20b5f39, $b9d3fbdb, $5579c0bd, $1a60320a,
    $d6a100c6, $402c7279, $679f25fe, $fb1fa3cc, $8ea5e9f8, $db3222f8,
    $3c7516df, $fd616b15, $2f501ec8, $ad0552ab, $323db5fa, $fd238760,
    $53317b48, $3e00df82, $9e5c57bb, $ca6f8ca0, $1a87562e, $df1769db,
    $d542a8f6, $287effc3, $ac6732c6, $8c4f5573, $695b27b0, $bbca58c8,
    $e1ffa35d, $b8f011a0, $10fa3d98, $fd2183b8, $4afcb56c, $2dd1d35b,
    $9a53e479, $b6f84565, $d28e49bc, $4bfb9790, $e1ddf2da, $a4cb7e33,
    $62fb1341, $cee4c6e8, $ef20cada, $36774c01, $d07e9efe, $2bf11fb4,
    $95dbda4d, $ae909198, $eaad8e71, $6b93d5a0, $d08ed1d0, $afc725e0,
    $8e3c5b2f, $8e7594b7, $8ff6e2fb, $f2122b64, $8888b812, $900df01c,
    $4fad5ea0, $688fc31c, $d1cff191, $b3a8c1ad, $2f2f2218, $be0e1777,
    $ea752dfe, $8b021fa1, $e5a0cc0f, $b56f74e8, $18acf3d6, $ce89e299,
    $b4a84fe0, $fd13e0b7, $7cc43b81, $d2ada8d9, $165fa266, $80957705,
    $93cc7314, $211a1477, $e6ad2065, $77b5fa86, $c75442f5, $fb9d35cf,
    $ebcdaf0c, $7b3e89a0, $d6411bd3, $ae1e7e49, $00250e2d, $2071b35e,
    $226800bb, $57b8e0af, $2464369b, $f009b91e, $5563911d, $59dfa6aa,
    $78c14389, $d95a537f, $207d5ba2, $02e5b9c5, $83260376, $6295cfa9,
    $11c81968, $4e734a41, $b3472dca, $7b14a94a, $1b510052, $9a532915,
    $d60f573f, $bc9bc6e4, $2b60a476, $81e67400, $08ba6fb5, $571be91f,
    $f296ec6b, $2a0dd915, $b6636521, $e7b9f9b6, $ff34052e, $c5855664,
    $53b02d5d, $a99f8fa1, $08ba4799, $6e85076a),

($4b7a70e9, $b5b32944,
    $db75092e, $c4192623, $ad6ea6b0, $49a7df7d, $9cee60b8, $8fedb266,
    $ecaa8c71, $699a17ff, $5664526c, $c2b19ee1, $193602a5, $75094c29,
    $a0591340, $e4183a3e, $3f54989a, $5b429d65, $6b8fe4d6, $99f73fd6,
    $a1d29c07, $efe830f5, $4d2d38e6, $f0255dc1, $4cdd2086, $8470eb26,
    $6382e9c6, $021ecc5e, $09686b3f, $3ebaefc9, $3c971814, $6b6a70a1,
    $687f3584, $52a0e286, $b79c5305, $aa500737, $3e07841c, $7fdeae5c,
    $8e7d44ec, $5716f2b8, $b03ada37, $f0500c0d, $f01c1f04, $0200b3ff,
    $ae0cf51a, $3cb574b2, $25837a58, $dc0921bd, $d19113f9, $7ca92ff6,
    $94324773, $22f54701, $3ae5e581, $37c2dadc, $c8b57634, $9af3dda7,
    $a9446146, $0fd0030e, $ecc8c73e, $a4751e41, $e238cd99, $3bea0e2f,
    $3280bba1, $183eb331, $4e548b38, $4f6db908, $6f420d03, $f60a04bf,
    $2cb81290, $24977c79, $5679b072, $bcaf89af, $de9a771f, $d9930810,
    $b38bae12, $dccf3f2e, $5512721f, $2e6b7124, $501adde6, $9f84cd87,
    $7a584718, $7408da17, $bc9f9abc, $e94b7d8c, $ec7aec3a, $db851dfa,
    $63094366, $c464c3d2, $ef1c1847, $3215d908, $dd433b37, $24c2ba16,
    $12a14d43, $2a65c451, $50940002, $133ae4dd, $71dff89e, $10314e55,
    $81ac77d6, $5f11199b, $043556f1, $d7a3c76b, $3c11183b, $5924a509,
    $f28fe6ed, $97f1fbfa, $9ebabf2c, $1e153c6e, $86e34570, $eae96fb1,
    $860e5e0a, $5a3e2ab3, $771fe71c, $4e3d06fa, $2965dcb9, $99e71d0f,
    $803e89d6, $5266c825, $2e4cc978, $9c10b36a, $c6150eba, $94e2ea78,
    $a5fc3c53, $1e0a2df4, $f2f74ea7, $361d2b3d, $1939260f, $19c27960,
    $5223a708, $f71312b6, $ebadfe6e, $eac31f66, $e3bc4595, $a67bc883,
    $b17f37d1, $018cff28, $c332ddef, $be6c5aa5, $65582185, $68ab9802,
    $eecea50f, $db2f953b, $2aef7dad, $5b6e2f84, $1521b628, $29076170,
    $ecdd4775, $619f1510, $13cca830, $eb61bd96, $0334fe1e, $aa0363cf,
    $b5735c90, $4c70a239, $d59e9e0b, $cbaade14, $eecc86bc, $60622ca7,
    $9cab5cab, $b2f3846e, $648b1eaf, $19bdf0ca, $a02369b9, $655abb50,
    $40685a32, $3c2ab4b3, $319ee9d5, $c021b8f7, $9b540b19, $875fa099,
    $95f7997e, $623d7da8, $f837889a, $97e32d77, $11ed935f, $16681281,
    $0e358829, $c7e61fd6, $96dedfa1, $7858ba99, $57f584a5, $1b227263,
    $9b83c3ff, $1ac24696, $cdb30aeb, $532e3054, $8fd948e4, $6dbc3128,
    $58ebf2ef, $34c6ffea, $fe28ed61, $ee7c3c73, $5d4a14d9, $e864b7e3,
    $42105d14, $203e13e0, $45eee2b6, $a3aaabea, $db6c4f15, $facb4fd0,
    $c742f442, $ef6abbb5, $654f3b1d, $41cd2105, $d81e799e, $86854dc7,
    $e44b476a, $3d816250, $cf62a1f2, $5b8d2646, $fc8883a0, $c1c7b6a3,
    $7f1524c3, $69cb7492, $47848a0b, $5692b285, $095bbf00, $ad19489d,
    $1462b174, $23820e00, $58428d2a, $0c55f5ea, $1dadf43e, $233f7061,
    $3372f092, $8d937e41, $d65fecf1, $6c223bdb, $7cde3759, $cbee7460,
    $4085f2a7, $ce77326e, $a6078084, $19f8509e, $e8efd855, $61d99735,
    $a969a7aa, $c50c06c2, $5a04abfc, $800bcadc, $9e447a2e, $c3453484,
    $fdd56705, $0e1e9ec9, $db73dbd3, $105588cd, $675fda79, $e3674340,
    $c5c43465, $713e38d8, $3d28f89e, $f16dff20, $153e21e7, $8fb03d4a,
    $e6e39f2b, $db83adf7),
  ($e93d5a68, $948140f7, $f64c261c, $94692934,
    $411520f7, $7602d4f7, $bcf46b2e, $d4a20068, $d4082471, $3320f46a,
    $43b7d4b7, $500061af, $1e39f62e, $97244546, $14214f74, $bf8b8840,
    $4d95fc1d, $96b591af, $70f4ddd3, $66a02f45, $bfbc09ec, $03bd9785,
    $7fac6dd0, $31cb8504, $96eb27b3, $55fd3941, $da2547e6, $abca0a9a,
    $28507825, $530429f4, $0a2c86da, $e9b66dfb, $68dc1462, $d7486900,
    $680ec0a4, $27a18dee, $4f3ffea2, $e887ad8c, $b58ce006, $7af4d6b6,
    $aace1e7c, $d3375fec, $ce78a399, $406b2a42, $20fe9e35, $d9f385b9,
    $ee39d7ab, $3b124e8b, $1dc9faf7, $4b6d1856, $26a36631, $eae397b2,
    $3a6efa74, $dd5b4332, $6841e7f7, $ca7820fb, $fb0af54e, $d8feb397,
    $454056ac, $ba489527, $55533a3a, $20838d87, $fe6ba9b7, $d096954b,
    $55a867bc, $a1159a58, $cca92963, $99e1db33, $a62a4a56, $3f3125f9,
    $5ef47e1c, $9029317c, $fdf8e802, $04272f70, $80bb155c, $05282ce3,
    $95c11548, $e4c66d22, $48c1133f, $c70f86dc, $07f9c9ee, $41041f0f,
    $404779a4, $5d886e17, $325f51eb, $d59bc0d1, $f2bcc18f, $41113564,
    $257b7834, $602a9c60, $dff8e8a3, $1f636c1b, $0e12b4c2, $02e1329e,
    $af664fd1, $cad18115, $6b2395e0, $333e92e1, $3b240b62, $eebeb922,
    $85b2a20e, $e6ba0d99, $de720c8c, $2da2f728, $d0127845, $95b794fd,
    $647d0862, $e7ccf5f0, $5449a36f, $877d48fa, $c39dfd27, $f33e8d1e,
    $0a476341, $992eff74, $3a6f6eab, $f4f8fd37, $a812dc60, $a1ebddf8,
    $991be14c, $db6e6b0d, $c67b5510, $6d672c37, $2765d43b, $dcd0e804,
    $f1290dc7, $cc00ffa3, $b5390f92, $690fed0b, $667b9ffb, $cedb7d9c,
    $a091cf0b, $d9155ea3, $bb132f88, $515bad24, $7b9479bf, $763bd6eb,
    $37392eb3, $cc115979, $8026e297, $f42e312d, $6842ada7, $c66a2b3b,
    $12754ccc, $782ef11c, $6a124237, $b79251e7, $06a1bbe6, $4bfb6350,
    $1a6b1018, $11caedfa, $3d25bdd8, $e2e1c3c9, $44421659, $0a121386,
    $d90cec6e, $d5abea2a, $64af674e, $da86a85f, $bebfe988, $64e4c3fe,
    $9dbc8057, $f0f7c086, $60787bf8, $6003604d, $d1fd8346, $f6381fb0,
    $7745ae04, $d736fccc, $83426b33, $f01eab71, $b0804187, $3c005e5f,
    $77a057be, $bde8ae24, $55464299, $bf582e61, $4e58f48f, $f2ddfda2,
    $f474ef38, $8789bdc2, $5366f9c3, $c8b38e74, $b475f255, $46fcd9b9,
    $7aeb2661, $8b1ddf84, $846a0e79, $915f95e2, $466e598e, $20b45770,
    $8cd55591, $c902de4c, $b90bace1, $bb8205d0, $11a86248, $7574a99e,
    $b77f19b6, $e0a9dc09, $662d09a1, $c4324633, $e85a1f02, $09f0be8c,
    $4a99a025, $1d6efe10, $1ab93d1d, $0ba5a4df, $a186f20f, $2868f169,
    $dcb7da83, $573906fe, $a1e2ce9b, $4fcd7f52, $50115e01, $a70683fa,
    $a002b5c4, $0de6d027, $9af88c27, $773f8641, $c3604c06, $61a806b5,
    $f0177a28, $c0f586e0, $006058aa, $30dc7d62, $11e69ed7, $2338ea63,
    $53c2dd94, $c2c21634, $bbcbee56, $90bcb6de, $ebfc7da1, $ce591d76,
    $6f05e409, $4b7c0188, $39720a3d, $7c927c24, $86e3725f, $724d9db9,
    $1ac15bb4, $d39eb8fc, $ed545578, $08fca5b5, $d83d7cd3, $4dad0fc4,
    $1e50ef5e, $b161e6f8, $a28514d9, $6c51133c, $6fd5c7e7, $56e14ec4,
    $362abfce, $ddc6c837, $d79a3234, $92638212, $670efa8e, $406000e0),

($3a39ce37, $d3faf5cf, $abc27737, $5ac52d1b, $5cb0679e, $4fa33742,
    $d3822740, $99bc9bbe, $d5118e9d, $bf0f7315, $d62d1c7e, $c700c47b,
    $b78c1b6b, $21a19045, $b26eb1be, $6a366eb4, $5748ab2f, $bc946e79,
    $c6a376d2, $6549c2c8, $530ff8ee, $468dde7d, $d5730a1d, $4cd04dc6,
    $2939bbdb, $a9ba4650, $ac9526e8, $be5ee304, $a1fad5f0, $6a2d519a,
    $63ef8ce2, $9a86ee22, $c089c2b8, $43242ef6, $a51e03aa, $9cf2d0a4,
    $83c061ba, $9be96a4d, $8fe51550, $ba645bd6, $2826a2f9, $a73a3ae1,
    $4ba99586, $ef5562e9, $c72fefd3, $f752f7da, $3f046f69, $77fa0a59,
    $80e4a915, $87b08601, $9b09e6ad, $3b3ee593, $e990fd5a, $9e34d797,
    $2cf0b7d9, $022b8b51, $96d5ac3a, $017da67d, $d1cf3ed6, $7c7d2d28,
    $1f9f25cf, $adf2b89b, $5ad6b472, $5a88f54c, $e029ac71, $e019a5e6,
    $47b0acfd, $ed93fa9b, $e8d3c48d, $283b57cc, $f8d56629, $79132e28,
    $785f0191, $ed756055, $f7960e44, $e3d35e8c, $15056dd4, $88f46dba,
    $03a16125, $0564f0bd, $c3eb9e15, $3c9057a2, $97271aec, $a93a072a,
    $1b3f6d9b, $1e6321f5, $f59c66fb, $26dcf319, $7533d928, $b155fdf5,
    $03563482, $8aba3cbb, $28517711, $c20ad9f8, $abcc5167, $ccad925f,
    $4de81751, $3830dc8e, $379d5862, $9320f991, $ea7a90c2, $fb3e7bce,
    $5121ce64, $774fbe32, $a8b6e37e, $c3293d46, $48de5369, $6413e680,
    $a2ae0810, $dd6db224, $69852dfd, $09072166, $b39a460a, $6445c0dd,
    $586cdecf, $1c20c8ae, $5bbef7dd, $1b588d40, $ccd2017f, $6bb4e3bb,
    $dda26a7e, $3a59ff45, $3e350a44, $bcb4cdd5, $72eacea8, $fa6484bb,
    $8d6612ae, $bf3c6f47, $d29be463, $542f5d9e, $aec2771b, $f64e6370,
    $740e0d8d, $e75b1357, $f8721671, $af537d5d, $4040cb08, $4eb4e2cc,
    $34d2466a, $0115af84, $e1b00428, $95983a1d, $06b89fb4, $ce6ea048,
    $6f3f3b82, $3520ab82, $011a1d4b, $277227f8, $611560b1, $e7933fdc,
    $bb3a792b, $344525bd, $a08839e1, $51ce794b, $2f32c9b7, $a01fbac9,
    $e01cc87e, $bcc7d1f6, $cf0111c3, $a1e8aac7, $1a908749, $d44fbd9a,
    $d0dadecb, $d50ada38, $0339c32a, $c6913667, $8df9317c, $e0b12b4f,
    $f79e59b7, $43f5bb3a, $f2d519ff, $27d9459c, $bf97222c, $15e6fc2a,
    $0f91fc71, $9b941525, $fae59361, $ceb69ceb, $c2a86459, $12baa8d1,
    $b6c1075e, $e3056a0c, $10d25065, $cb03a442, $e0ec6e0e, $1698db3b,
    $4c98a0be, $3278e964, $9f1f9532, $e0d392df, $d3a0342b, $8971f21e,
    $1b0a7441, $4ba3348c, $c5be7120, $c37632d8, $df359f8d, $9b992f2e,
    $e60b6f47, $0fe3f11d, $e54cda54, $1edad891, $ce6279cf, $cd3e7e6f,
    $1618b166, $fd2c1d05, $848fd2c5, $f6fb2299, $f523f357, $a6327623,
    $93a83531, $56cccd02, $acf08162, $5a75ebb5, $6e163697, $88d273cc,
    $de966292, $81b949d0, $4c50901b, $71c65614, $e6c6c7bd, $327a140a,
    $45e1d006, $c3f27b9a, $c9aa53fd, $62a80f00, $bb25bfe2, $35bdd2f6,
    $71126905, $b2040222, $b6cbcf7c, $cd769c2b, $53113ec0, $1640e3d3,
    $38abbd60, $2547adf0, $ba38209c, $f746ce76, $77afa1c5, $20756060,
    $85cbfe4e, $8ae88dd8, $7aaaf9b0, $4cf9aa7e, $1948c25c, $02fb8a8c,
    $01c36ae4, $d6ebe1f9, $90d4f869, $a65cdea0, $3f09252d, $c208e69f,
    $b74e6132, $ce77e25b, $578fdfe3, $3ac372e6));implementationvar
//实际加密使用的子密钥
  Key_Boxes: array[1..1042] of LongWord;//BlowFish解密函数，入口、出口都是64位
function BlowFish_DN(PT: int64): int64;
var
  i: byte;
  xL, xR, tmp: LongWord;
  r: int64;
begin
  xL := PT shr $20;
  xR := PT mod $100000000;
  xR := xR xor Key_Boxes[17];
  xL := xL xor Key_Boxes[18];
  for i:=16 downto 1 do
  begin
    if i<16 then
    begin
      tmp := xR; xR := xL; xL := tmp;
    end;
    xR := BlowFish_Func(xL) xor xR;
    xL := xL xor Key_Boxes[i];
  end;
  r := xL;
  r := (r shl $20) or xR;
  Result := r;
end; //BlowFish加密函数，参数同上
function BlowFish_EN(PT: int64): int64;
var
  i: byte;
  xL, xR, tmp: LongWord;
  r: int64;
begin
  xL := PT shr $20;
  xR := PT mod $100000000;
  for i:=1 to 16 do
  begin
    xL := xL xor Key_Boxes[i];
    xR := BlowFish_Func(xL) xor xR;
    if i<16 then
    begin
      tmp := xR; xR := xL; xL := tmp;
    end;
  end;
  xR := xR xor Key_Boxes[17];
  xL := xL xor Key_Boxes[18];
  r := xL;
  r := (r shl $20) or xR;
  Result := r;
end; //BlowFish中间的运算函数，入口、出口参数都是32位
function BlowFish_Func(PT: LongWord): LongWord;
var
  a, b, c, d: byte;
begin
  a := (PT and $FF000000) shr $18;
  b := (PT and $00FF0000) shr $10;
  c := (PT and $0000FF00) shr $8;
  d := (PT and $000000FF);   Result := (((Key_Boxes[a+19] + Key_Boxes[b+19+256]) mod 4294967296) xor Key_Boxes[c+19+512] + Key_Boxes[d+19+768]) mod 4294967296;
end; //BlowFish的初始化，得到子密钥，放在Key_Boxes中
procedure BlowFish_Init(Key: string);
var
  i, j, k: integer;
  tmp: LongWord;
  PT: int64;
begin
  FillChar(Key_Boxes, SizeOf(Key_Boxes), 0); //变换填充P盒
  j := 1;
  for i:=1 to 18 do
  begin
    tmp := 0;
    for k:=0 to 3 do
    begin
      tmp := (tmp shl 8) or Ord(Key[j]);
      inc(j);
      if j>Length(Key) then
        j := 1;
    end;
    Key_Boxes[i] := pBox[i] xor tmp;
  end; //填充S盒
  for i:=0 to 3 do
  for j:=0 to 255 do
    Key_Boxes[i*256+j+19] := sBox[i+1, j+1]; //开始连续填充
  PT := 0;
  for i:=1 to 521 do
  begin
    PT := BlowFish_EN(PT);
    Key_Boxes[i*2-1] := PT shr $20;
    Key_Boxes[i*2] := PT mod $100000000;
  end;
end;end.

to ksaiy(消失在人海)
我已经开了两个新贴，共200分，这样把分给你不会算我们做毕吧？

PB也是一样的.具体的内容你可以修改一下。如果不想写那些代码.你可以直接去我主页上下载已经做集成好的DLL直接调用不吧.
http://www.ksaiy.com/ynen

呵呵:)
再给你帖一个自校验用到的源码:
CRC的,文件大小的在上面我已经给你贴过了。
unit Crc32;interfaceuses Windows;  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);procedure CalcCRC32(FileName: string; var CRC32: DWORD);

implementationprocedure CalcCRC32(FileName: string; 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);
      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;end.

这个帖子把他弄到FAQ里去.方便以后大家查询吧.
呵呵:)

我只用过GetVolumeInformation()这个函数，我试过几百台机子，不会出现重复的ID号，你如果有兴趣可以试试，

调试易

如何让程序只能在一台机器上运行。(序列号)。如成功可再加分

解决方案 »