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

📄 unit1.~pas

📁 Of the password is: Server: "1." Client: + for the month of the date of the machine. Such as
💻 ~PAS
📖 第 1 页 / 共 4 页
字号:
{
 本程序使用DELPHI 6.0编制
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, ComCtrls, ToolWin, ExtCtrls, Menus, DB, DBTables,
  NMUDP, StdCtrls, Mask, DBCtrls, ImgList, Psock, NMDayTim,Winsock,
  shellapi,mmsystem, ScktComp, ADODB, jpeg,nb30, Registry;
  const wm_icb=wm_user+1000; //任务栏建图标用

 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;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    Panel1: TPanel;
    ToolBar1: TToolBar;
    SB1: TStatusBar;
    N2: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    PopupMenu1: TPopupMenu;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    CUDP: TNMUDP;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    Timer1: TTimer;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    ImageList1: TImageList;
    lv1: TListView;
    Splitter1: TSplitter;
    Panel3: TPanel;
    Splitter2: TSplitter;
    Panel4: TPanel;
    Panel5: TPanel;
    Splitter3: TSplitter;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    lv2: TListView;
    lv3: TListView;
    lv4: TListView;
    Timer2: TTimer;
    NMDayTime1: TNMDayTime;
    N19: TMenuItem;
    N22: TMenuItem;
    N24: TMenuItem;
    N26: TMenuItem;
    N21: TMenuItem;
    N20: TMenuItem;
    N23: TMenuItem;
    tccd: TPopupMenu;
    N27: TMenuItem;
    N28: TMenuItem;
    N3: TMenuItem;
    ADOCon1: TADOConnection;
    tb1: TADOQuery;
    tb1a1: TWideStringField;
    tb1a2: TWideStringField;
    tb1a3: TDateTimeField;
    tb1a4: TDateTimeField;
    tb1a5: TDateTimeField;
    tb1a6: TWideStringField;
    tb1a7: TFloatField;
    tb1a8: TFloatField;
    tb1a10: TFloatField;
    tb1a11: TFloatField;
    tb1a13: TWideStringField;
    tb1a14: TWideStringField;
    tb1a15: TWideStringField;
    tb1IP: TWideStringField;
    tb1a16: TWideStringField;
    tb1a17: TWideStringField;
    Table1: TADOTable;
    Table1a0: TWideStringField;
    Table1a1: TWideStringField;
    Table1a3: TDateTimeField;
    Table1a4: TDateTimeField;
    Table1a2: TDateTimeField;
    Table1a5: TWideStringField;
    Table1a6: TFloatField;
    Table1a7: TFloatField;
    Table1a9: TFloatField;
    Table1a10: TFloatField;
    Table1a12: TWideStringField;
    Table1a13: TWideStringField;
    Table1a15: TWideStringField;
    Table1IP: TWideStringField;
    Table1a16: TWideStringField;
    Table1a17: TWideStringField;
    table4: TADOTable;
    table4a0: TWideStringField;
    table4a1: TFloatField;
    table4a2: TFloatField;
    table4a3: TWideStringField;
    Table3: TADOTable;
    Table3a1: TWideStringField;
    Table3a2: TWideStringField;
    Table3a3: TWideStringField;
    Table3a4: TDateTimeField;
    Table3a5: TFloatField;
    Table3a6: TWideStringField;
    Table3a7: TWideStringField;
    Table3a8: TWideStringField;
    Table3a9: TFloatField;
    Table2: TADOTable;
    Table2a1: TWideStringField;
    Table2a2: TDateTimeField;
    Table2a3: TDateTimeField;
    Table2a4: TDateTimeField;
    Table2a5: TWideStringField;
    Table2a6: TFloatField;
    Table2a8: TFloatField;
    Table2a9: TFloatField;
    Table2a10: TWideStringField;
    Table2a11: TWideStringField;
    tb1a9: TFloatField;
    tb1a12: TFloatField;
    Table1a8: TFloatField;
    Table1a11: TFloatField;
    Table2a7: TFloatField;
    N25: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    N29: TMenuItem;
    Timer3: TTimer;
    tb1a18: TAutoIncField;
    Label1: TLabel;
    Label2: TLabel;
    N30: TMenuItem;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure CUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure N13Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure lv1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure lv1_create_date;
    procedure lv1CustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure lv1EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure lv1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure lv1StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure lv1StartDock(Sender: TObject;
      var DragObject: TDragDockObject);
    procedure jlsx(cs:integer);
    procedure lv2sx(dl,jr,fs:string);
    procedure Panel8DblClick(Sender: TObject);
    procedure Panel5DblClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Panel5Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure lv2DblClick(Sender: TObject);
    procedure lv4DblClick(Sender: TObject);
    procedure lv3DblClick(Sender: TObject);
    procedure FXX(xxly:string;IP:string);   //发控制码
    procedure lv1DblClick(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure N28Click(Sender: TObject);
    procedure ycck;
    procedure WMSysCommand(var Msg: TWMSysCommand);message WM_SYSCOMMAND;
    procedure N27Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    function xq_mima():string;
    procedure N25Click(Sender: TObject);
    procedure lv1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure N29Click(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure N30Click(Sender: TObject);

  private
    { Private declarations }

  myicon:TNotifyicondata;   //任务栏建图标用
    procedure wmicb(var msg:TMessage);message wm_icb; //任务栏建图标用
    procedure hydl(kjIP,zh,xm,zjh:string;yj,bz:real);
    procedure hyjz(kjip:string); //会员结帐
    procedure lkjz(kjip:string);  //临卡结帐
    function FindComputer(ComputerName: string):Boolean;
  public
    { Public declarations }
        zdxs1:integer;
        td1,td2:string;  //拖动时保存原与目标对象名
  end;

var
  Form1: TForm1;
  jsjm:string='xq'; //存计算机名变量
  sizong:integer=0; //存时钟
  yfdj:string='2' ; //初始化押金
  zgtq: string='wertw'; //主管持权为"system" 有特权
  mimasla1:string;

implementation


uses Unit2,unit3, Unit4, Unit5, Unit6, Unit7, Unit8, Unit9, Unit10;

const BufSize=2048;
var
  RsltStream,TmpStream,BmpStream:TMemoryStream;


{$R *.dfm}
//自定义子程序区

//获网卡卡号
function GetMAC(CardNo: integer): string;
//CardNo指定多个网卡适配器中的哪一个0,1,2...
var
  NCB: TNCB; // Netbios control block file://NetBios控制块
  ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取网卡状态
  LANAENUM: TLANAENUM; // Netbios lana
  intIdx: Integer; // Temporary work value//临时变量
  cRC: Char; // Netbios return code//NetBios返回值
  strTemp: string; // Temporary string//临时变量
begin
  // Initialize
  Result := '';
  try
    // Zero control blocl
    ZeroMemory(@NCB, SizeOf(NCB));
    // Issue enum command
    NCB.ncb_command := Chr(NCBENUM);
    cRC := NetBios(@NCB);
    // Reissue enum command
    NCB.ncb_buffer := @LANAENUM;
    NCB.ncb_length := SizeOf(LANAENUM);
    cRC := NetBios(@NCB);
    if Ord(cRC) <> 0 then Exit;
    // Reset adapter
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_command := Chr(NCBRESET);
    NCB.ncb_lana_num := LANAENUM.lana[0];
    cRC := NetBios(@NCB);
    if Ord(cRC) <> 0 then Exit;
    // Get adapter address
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_command := Chr(NCBASTAT);
    NCB.ncb_lana_num := LANAENUM.lana[0];
    StrPCopy(NCB.ncb_callname, '*');
    NCB.ncb_buffer := @ADAPTER;
    NCB.ncb_length := SizeOf(ADAPTER);
    cRC := NetBios(@NCB);
    // Convert it to string
    strTemp := '';
    for intIdx := 0 to 5 do
      strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
    Result := strTemp;
   finally
   end;
end;


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;

function GetIdeDiskSerialNumber : String;
var 
hDevice : THandle; 
cbBytesReturned : DWORD; 
pInData : PSendCmdInParams; 
pOutData : Pointer; // PSendCmdOutParams 
Buffer : Array[0..BufferSize-1] of Byte; 
srbControl : TSrbIoControl absolute Buffer; 
begin
Result:=' '; 
FillChar(Buffer,BufferSize,#0); 
if Win32Platform=VER_PLATFORM_WIN32_NT then 
begin // Windows NT, Windows 2000 
// Get SCSI port handle 
hDevice := CreateFile( '\\.\Scsi0:', 
GENERIC_READ or GENERIC_WRITE, 
FILE_SHARE_READ or FILE_SHARE_WRITE, 
nil, OPEN_EXISTING, 0, 0 ); 
if hDevice=INVALID_HANDLE_VALUE then Exit; 
try 
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL); 
System.Move('SCSIDISK',srbControl.Signature,8); 
srbControl.Timeout := 2; 
srbControl.Length := DataSize; 
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY; 
pInData := PSendCmdInParams(PChar(@Buffer) 
+SizeOf(SRB_IO_CONTROL)); 
pOutData := pInData; 
with pInData^ do 
begin 
cBufferSize := IDENTIFY_BUFFER_SIZE; 
bDriveNumber := 0; 
with irDriveRegs do 
begin 
bFeaturesReg := 0; 
bSectorCountReg := 1; 
bSectorNumberReg := 1; 
bCylLowReg := 0; 
bCylHighReg := 0; 
bDriveHeadReg := $A0; 
bCommandReg := IDE_ID_FUNCTION; 
end; 
end; 
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, 
@Buffer, BufferSize, @Buffer, BufferSize, 
cbBytesReturned, nil ) then Exit; 
finally 
CloseHandle(hDevice); 
end; 
end 
else 
begin // Windows 95 OSR2, Windows 98 
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, 
CREATE_NEW, 0, 0 ); 
if hDevice=INVALID_HANDLE_VALUE then Exit; 
try 
pInData := PSendCmdInParams(@Buffer); 
pOutData := @pInData^.bBuffer; 
with pInData^ do 
begin 
cBufferSize := IDENTIFY_BUFFER_SIZE; 
bDriveNumber := 0; 
with irDriveRegs do 
begin 
bFeaturesReg := 0; 
bSectorCountReg := 1; 
bSectorNumberReg := 1; 
bCylLowReg := 0; 
bCylHighReg := 0; 
bDriveHeadReg := $A0; 
bCommandReg := IDE_ID_FUNCTION; 
end; 
end; 
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, 
pInData, SizeOf(TSendCmdInParams)-1, pOutData, 
W9xBufferSize, cbBytesReturned, nil ) then Exit; 
finally 
CloseHandle(hDevice); 
end; 
end; 
with PIdSector(PChar(pOutData)+16)^ do 
begin 
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
SetString(Result,sSerialNumber,SizeOf(sSerialNumber)); 
end;
end;

⌨️ 快捷键说明

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