⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 理论考试程序,可以自由下载,学习,请多多指点,批评
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Registry,Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls, DB, ADODB;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Label6: TLabel;
    BitBtn2: TBitBtn;
    Image2: TImage;
    Button2: TButton;
    ListBox1: TListBox;
    Image4: TImage;
    Label2: TLabel;
    ADOTable1: TADOTable;
    ADOTable1T_id: TWideStringField;
    ADOTable1question: TMemoField;
    ADOTable1CURRECTANSWER: TWideStringField;
    ADOTable1ANSWER1: TWideStringField;
    ADOTable1ANSWER2: TWideStringField;
    ADOTable1ANSWER3: TWideStringField;
    ADOTable1IMG: TWideStringField;
    ADOTable1CLASS1: TWideStringField;
    ADOTable1CLASS2: TWideStringField;
    ADOTable1xh: TWideStringField;
    Label5: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Image1: TImage;
    ListBox2: TListBox;
    Label3: TLabel;
    ListBox3: TListBox;
    SpeedButton3: TSpeedButton;
    Label4: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Button1: TButton;
    Button3: TButton;
    Button4: TButton;
    SpeedButton4: TSpeedButton;
    Label9: TLabel;
    Label10: TLabel;
    Bevel1: TBevel;
    Timer1: TTimer;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Image2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    function pass(pstr:string):string;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure Label3DblClick(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3, Unit4, Unit6, Unit7, Unit8, Unit10, Unit9;

{$R *.dfm}

Const
  ID_BIT = $200000;

Type
  TCPUID = Array[1..4] of Longint;                // 储存CPU ID号
 //   TCPUID  = array[1..4] of Longint;
  TVendor = array [0..11] of char;

function Tform1.pass(pstr:string):string;
var str,str1:string;
i,j:integer;
begin
str:=pstr;
for i:=1 to length(str) do begin
//进行第一次变换
//进行第一次变换
j:=(i*i*i mod (i+1))+(i*i mod (i+1))+i*3+1;
str1:=str1+chr(ord(str[i])+j); //第二次变换
j:=(i*i*i mod (i+1))+(i*i mod (i+1))+i*3+1;
str1:=str1+chr(ord(str[i])+j);
end;
pass:=str1;
end;

//type

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 GetCPUVendor : TVendor; assembler; register;
asm
  PUSH    EBX               {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX           {@Result (TVendor)}
  MOV     EAX,0
  DW      $A20F             {CPUID Command}
  MOV     EAX,EBX
  XCHG          EBX,ECX     {save ECX result} 
  MOV                   ECX,4
@1: 
  STOSB
  SHR     EAX,8 
  LOOP    @1
  MOV     EAX,EDX 
  MOV                   ECX,4
@2: 
  STOSB
  SHR     EAX,8 
  LOOP    @2
  MOV     EAX,EBX 
  MOV                   ECX,4
@3: 
  STOSB
  SHR     EAX,8 
  LOOP    @3
  POP     EDI              {Restore registers} 
  POP     EBX
end;
function  getnewcpuid:string;

var
v:TCPUID;
begin
v:=GetCPUID;
Result:=copy((IntToStr(v[1])+IntToStr(v[2])+IntToStr(v[3])+IntToStr(v[4])),1,8);
end;


Function   EncrypKey(Src:String;   Key:String):string;
  var
//  idx   :integer;
  KeyLen   :Integer;   
  KeyPos   :Integer;   
  offset   :Integer;   
  dest   :string;   
  SrcPos   :Integer;   
  SrcAsc   :Integer;
//  TmpSrcAsc   :Integer;
  Range   :Integer;

  begin   
  KeyLen:=Length(Key);   
  if   KeyLen   =   0   then   key:='Think   Space';
  KeyPos:=0;   
 // SrcPos:=0;
//  SrcAsc:=0;
  Range:=256;   

  Randomize;   
  offset:=Random(Range);   
  dest:=format('%1.2x',[offset]);   
  for   SrcPos   :=   1   to   Length(Src)   do   
  begin
  SrcAsc:=(Ord(Src[SrcPos])   +   offset)   MOD   255;
  if   KeyPos   <   KeyLen   then   KeyPos:=   KeyPos   +   1   else   KeyPos:=1;   
  SrcAsc:=   SrcAsc   xor   Ord(Key[KeyPos]);   
  dest:=dest   +   format('%1.2x',[SrcAsc]);   
  offset:=SrcAsc;   
  end;   
  Result:=Dest;
  end;   
function ISCPUID:Boolean;register;
asm             { 查看该机是否有CPU ID 号可以查 }
  PUSHFD
  POP    EAX
  MOV    EDX,EAX
  XOR    EAX,ID_BIT
  PUSH   EAX
  POPFD
  PUSHFD
  POP    EAX
  XOR    EAX,EDX
  JZ     @exit
  MOV    AL,TRUE
  @exit:
end;


  Function   UncrypKey(Src:String;   Key:String):string;
  var
//  idx   :integer;
  KeyLen   :Integer;
  KeyPos   :Integer;
  offset   :Integer;
  dest   :string;
  SrcPos   :Integer;
  SrcAsc   :Integer;
  TmpSrcAsc   :Integer;
//  Range   :Integer;

  begin
  KeyLen:=Length(Key);
  if   KeyLen   =   0   then   key:='Think   Space';
  KeyPos:=0;
//  SrcPos:=0;
//  SrcAsc:=0;
//  Range:=256;
 try
  offset:=StrToInt('$'+   copy(src,1,2));
  except
    begin
 Messagebox(application.handle,pchar('注册码输入错误!!'),'系统提示',mb_ok+mb_iconinformation);
         result:='';
     exit;
     end;
  end;
  SrcPos:=3;
  repeat
 SrcAsc:=StrToInt('$'+   copy(src,SrcPos,2));
  if   KeyPos   <   KeyLen   Then   KeyPos   :=   KeyPos   +   1   else   KeyPos   :=   1;
  TmpSrcAsc   :=   SrcAsc   xor   Ord(Key[KeyPos]);   
  if   TmpSrcAsc   <=   offset   then   
  TmpSrcAsc   :=   255   +   TmpSrcAsc   -   offset   
  else   
  TmpSrcAsc   :=   TmpSrcAsc   -   offset;   
  dest   :=   dest   +   chr(TmpSrcAsc);   
  offset:=srcAsc;   
  SrcPos:=SrcPos   +   2;   
  until   SrcPos   >=   Length(Src);   
  Result:=Dest;   
  end; 

function GetIdeDiskSerialNumber  :pchar; stdcall;

{得到硬盘序列号过程}
type
  TSrbIoControl = packed record
    HeaderLength : ULONG;
    Signature : Array[0..7] of Char;
    Timeout : ULONG;
    ControlCode : ULONG;
    ReturnCode : ULONG;
    Length : ULONG;
  end;
  SRB_IO_CONTROL = TSrbIoControl;
  PSrbIoControl = ^TSrbIoControl;
  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. Must be zero.
  end;
  IDEREGS = TIDERegs;
  PIDERegs = ^TIDERegs;
  TSendCmdInParams = packed record
    cBufferSize : DWORD;
    irDriveRegs : TIDERegs;
    bDriveNumber : Byte;
    bReserved : Array[0..2] of Byte;
    dwReserved : Array[0..3] of DWORD;
    bBuffer : Array[0..0] of Byte;
  end;
  SENDCMDINPARAMS = TSendCmdInParams;
  PSendCmdInParams = ^TSendCmdInParams;
  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 : ULONG;
    wMultSectorStuff : Word;
    ulTotalAddressableSectors : ULONG;
    wSingleWordDMA : Word;
    wMultiWordDMA : Word;
    bReserved : Array[0..127] of Byte;
  end;
  PIdSector = ^TIdSector;
const
  IDE_ID_FUNCTION = $EC;
  IDENTIFY_BUFFER_SIZE = 512;
  DFP_RECEIVE_DRIVE_DATA = $0007c088;
  IOCTL_SCSI_MINIPORT = $0004d008;
  IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
  DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
  BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
  W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;
var

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -