📄 unit1.~pas
字号:
{
本程序使用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 + -