📄 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;
const wm_icb=wm_user+1000; //任务栏建图标用
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;
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);
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 tform1.xq_mima():string;
var
aboutf:tmimasl; //公用密码输入
begin
aboutf:=tmimasl.Create(self);
aboutf.ShowModal;
Result :=mimasla1;
end;
function tform1.FindComputer(ComputerName: string):Boolean;
//在局域网上以计算机名查找是否存在 TRUE 在 FALSE 不在
var
WSAData: TWSAData;
HostEnt: PHostEnt;
begin
WSAStartup(2, WSAData);
HostEnt := gethostbyname(PChar(ComputerName));
if HostEnt = nil then Result := False
else Result :=True;
WSACleanup;
end;
procedure tform1.hydl(kjIP,zh,xm,zjh:string;yj,bz:real);
//参数：KJDL 客户机IP ZH 帐号 XM 姓名 ZJH 证件号
// yj 押金 bz 计费准
label jlsk; //标签
var
jlsk1:string;
jlsk2:integer;
//在表控件table1中查找记录
begin
jlsk2:=234123;
form1.Table1.First;
while not (form1.Table1.Eof) do
begin
if form1.Table1ip.Value=kjip then goto jlsk;
form1.Table1.Next;
end;
jlsk2:=0;
jlsk: //标签
if jlsk2<>0 then
//找到
begin
form1.table1.edit;
form1.table1a5.Value:=zh;
form1.table1a3.Value:=DATe;
form1.table1a4.Value:=now;
form1.table1a12.Value:=xm;
form1.table1a13.Value:=zjh;
form1.table1a7.Value:=yj;
form1.table1a6.Value:=bz;
form1.table1a15.Value:='√';
jlsk1:=form1.Table1a1.Value;
form1.table1.post;
table1.Refresh;
form1.jlsx(0);
end;
end;
procedure Tform1.lv1_create_date;
//列表视图lv1与数据库建立关联
var
item:tlistitem;
gb2,gb3:string; //用于改变时间显示去掉秒
begin
lv1.Clear;
tb1.First;
while not tb1.Eof do
begin
if tb1a11.Value<3 then zdxs1:=1 else zdxs1:=0;
item:=lv1.Items.Add;
item.Caption:=tb1a2.Value; //电脑项
item.SubItems.Add(tb1a1.Value); //状态
//上机时间项
if tb1a4.Value<>strtotime('0:0:0') then item.SubItems.Add(timetostr(tb1a4.Value)) else item.SubItems.Add('');
item.SubItems.Add(tb1a6.Value); //卡号项
if tb1a8.Value<>0 then item.SubItems.Add(tb1a8.AsString) //押金项
else item.SubItems.Add('');
//计费标准项
gb2:=tb1a6.Value;
delete(gb2,3,12);
if gb2='L-' then if tb1a7.Value<>0 then item.SubItems.Add('临时上机') else item.SubItems.Add('')
else if tb1a7.Value<>0 then item.SubItems.Add('会员上机') else item.SubItems.Add('');
gb2:=tb1a15.Value;
if gb2='T' then item.SubItems[4]:='托管上机'; // 有全脱标志
//已用时项
gb2:=floattostr(trunc(tb1a9.Value/60))+':'+floattostr(tb1a9.AsInteger mod 60);
if gb2<>'0:0' then item.SubItems.Add(gb2) else item.SubItems.Add('');
// 费用项
if tb1a10.Value<>0 then item.SubItems.Add(tb1a10.AsString) else item.SubItems.Add('');
// 应退项
if tb1a11.Value<>0 then item.SubItems.Add(tb1a11.AsString) else item.SubItems.Add('');
//剩余时间项
gb3:=floattostr(trunc(tb1a12.Value/60))+':'+floattostr(tb1a12.AsInteger mod 60);
if gb3<>'0:0' then item.SubItems.Add(gb3) else item.SubItems.Add('');
item.SubItems.Add(tb1a13.Value);
item.SubItems.Add(tb1a14.Value);
item.SubItems.Add(tb1IP.Value);
item.SubItems.Add(tb1a15.Value);
item.SubItems.Add(tb1a16.Value);
tb1.Next;
end;
end;
procedure TForm1.FXX(xxly:string;IP:string); //发控制码
//参数：XXLY 消息内容 最多250个字符 IP 客户机的IP地址
var
ReqCode:array[0..250] of char;
ReqCodeStr:string;
begin
if IP<>'' then
begin
ReqCodeStr:=xxly;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
CUDP.RemoteHost:=IP;
CUDP.SendBuffer(ReqCode,250);
end;
end;
procedure tform1.jlsx(cs:integer);
//刷新数据库 cs: 是否测试开机 0 不测 1 测
begin
with table1 do
begin
disablecontrols;
table1.First;
while not eof do
begin //循环
if (table1a6.Value>0) and (table1ip.Value<>'') then //对一条记录处理 有计费标准说明在计费
//if-1 开始
begin //-----11
table1.Edit;
//datetimetofiledate(a:datetime) 把日期和时间换成数字
table1a8.Value:=round((now-table1a4.Value)*60*24); //已用时
table1a9.Value:=round((table1a8.AsFloat*(table1a6.Value/60))*10)/10;//费用
table1a11.Value:=(table1a7.AsFloat/table1a6.Value)*60-table1a8.AsFloat;
//剩余时间
table1a10.Value:=table1a7.Value-table1a9.Value;
//应退款
fxx('sfnw1'+NMDayTime1.LocalIP,table1ip.Value); //查是否联网
table1a0.Value:='×';
table1.Post;
//已到时间锁定机器 如押金=0则不执行
if (table1a7.Value<>0) and (table1a10.Value<=0) then lkjz(table1ip.Value)
// 快到时间提醒 如押金=0则不执行 上行执行则下行不执行
// 以免锁定了还在提醒
else
if (table1a7.Value<>0) and (table1a11.Value<=5) then fxx('ccompu'+floattostr(table1a11.Value),table1ip.Value);
end //-------11
else
begin
fxx('sfnw2'+NMDayTime1.LocalIP,table1ip.Value); //查是否联网
table1.Edit;
table1a0.Value:='×'; // 没有计费则标志设为锁定
end; //对一条记录处理
//if-1 完
//// 以计算机名查找此机是否脱网 是则状态设为 "？"
table1.Edit;
if cs=1 then if findcomputer(table1a1.Text) then table1a0.Value:='?';
//下一记录
table1.Next;
enablecontrols;
end; //循环完
table1.First;
//刷新listvice (lv1)
tb1.Close;
tb1.Prepared;
tb1.Open;
lv1_create_date;
end; //刷新数据库
end; //刷新函数完
procedure TForm1.lv2sx(dl,jr,fs:string);
//加钱记录显示 di 电脑名 jr 加钱金额 fs 方式（即上机：加钱）
var
itema1:tlistitem;
begin
itema1:=lv2.Items.Add;
itema1.Caption:=dl;
itema1.SubItems.Add(timetostr(now));
itema1.SubItems.Add(jr);
itema1.SubItems.add(fs);
end;
//会员结帐
procedure TForm1.hyjz(kjip:string);
label bh1; //标签
var
str1,str2,str3:string;
itemlv4:tlistitem;
begin
timer2.Enabled:=false; // 关闭timer2 时钟 因为它在调用tb1
str1:=tb1.SQL.Text; //保存上次SQL的操作
str2:='select * from temp where IP="'+kjip+'"';
tb1.Close;
tb1.SQL.Clear;
tb1.SQL.Add(str2);
tb1.Prepared;
tb1.Open;
if tb1.RecordCount=0 then goto bh1; // 没有查到该IP 出错退出
if tb1a6.Value='' then goto bh1; //没有上机
tb1.First;
str3:=tb1a6.Value;
delete(str3,3,12);
if str3='L-' then
begin fxx('xx'+'你不是会员，下机找网管。',kjip);
goto bh1;
end;
fxx('hdesk',kjip); // 锁定客机
//在结帐记录上显示
itemlv4:=lv4.Items.Add;
itemlv4.Caption:=tb1a2.Value; //电脑
str3:=timetostr(tb1a4.Value); //上机时间
itemlv4.SubItems.Add(str3);
str3:=timetostr(now); //下机时间
itemlv4.SubItems.Add(str3);
str3:=floattostr(tb1a8.Value); //押金
itemlv4.SubItems.Add(str3);
str3:=timetostr(tb1a9.Value); //用时
itemlv4.SubItems.Add(str3);
str3:=floattostr(tb1a10.Value); //费用
itemlv4.SubItems.Add(str3);
str3:=floattostr(tb1a11.Value); //应退
itemlv4.SubItems.Add(str3);
str3:=tb1a6.Value; //卡号
itemlv4.SubItems.Add(str3);
// 显示完
//添加到历史记录中
table2.Active:=true; //打开历史库
table2.Insert;
table2a1.Value:=tb1a2.Value; //电脑
table2a2.Value:=date;
table2a3.Value:=tb1a4.Value; //上机时间
table2a4.Value:=now; //下机时间
table2a6.Value:=tb1a8.Value; //押金
table2a7.Value:=tb1a9.Value; //用时
table2a8.Value:=tb1a10.Value; //费用
table2a9.Value:=0; //应退
table2a5.Value:=tb1a6.Value; //卡号
table2a10.Value:=tb1a13.Value; //姓名
table2a11.Value:=tb1a14.Value; //证件
table2.Post;
table2.Active:=false; //操作完关库
//添加历史库完
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -