📄 umain.~pas
字号:
comonoff:=0;
sport:=5002;
form1.registerstyle:=1;
form1.ExtendSerialNo:='';
form1.SerialNo:=0;
form1.StartType:=1;
form1.serverIP:='';
form1.serverport:=0;
form1.writeinifile(1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
//func:send_user_data;
userid:array[1..12] of char;
src:array[1..1024] of char;
len:cardinal;
buf:arr;
i:integer;
s:string;
begin
if edit2.Text='' then exit;
for i:=1 to length(edit2.Text) do
userid[i]:=(edit2.text)[i];
//@func:=GetProcAddress(hand,'do_send_user_data'); //取发送函数地址
if (@function_do_send_user_data=nil) then
begin
memo1.lines.Add('取不到 do_send_user_data 地址');
exit;
end;
len:=length(edit1.Text);
if len>0 then
begin
if radiobutton2.Checked then
begin
src[1]:=char($03);
src[2]:=char(len);
len:=len+2;
for i:=3 to len do
src[i]:=edit1.text[i-2];
end
else //radiobutton1.checked
begin
for i:=1 to length(edit1.text) do
if not legalchar(edit1.text[i]) then
begin
showmessage('字符错误,位置:'+inttostr(i)+chr(13)+'字符输入范围:0~9、a~f、A~F');
exit;
end;
s:=strtohex(edit1.text);
for i:=1 to length(s) do
src[i]:=s[i];
len:=length(s);
end;
function_do_send_user_data(@userid[1],@src[1],len,@buf[1]); //发送数据
end;
memo1.Lines.Add('向 '+edit2.text+' 发送数据:'+edit1.Text)
end;
procedure TForm1.N8Click(Sender: TObject);
begin
application.CreateForm(tfotherset,fotherset);
fotherset.ShowModal;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
application.CreateForm(tfcomset,fcomset);
fcomset.ShowModal;
end;
procedure TForm1.CheckBox3Click(Sender: TObject);
var cdcb:DCB;
begin
if checkbox3.Checked then
begin //1
comhand:=CreateFile(pchar('COM'+inttostr(form1.comnum)),generic_read or generic_write,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
if (comhand=invalid_handle_value) then
begin //1.1
memo1.lines.Add('无法打开串口');
checkbox3.Checked:=false;
exit;
end; //1.1
PurgeComm(comhand,PURGE_RXABORT or PURGE_RXABORT or PURGE_RXCLEAR or PURGE_TXCLEAR);
SetUPComm(comhand,2048,2048);
GetCommState(comhand,cdcb); //取得串口配置信息
cdcb.BaudRate:=form1.baudrate;
cdcb.ByteSize:=form1.databit;
cdcb.Parity:=form1.parity;
cdcb.StopBits:=form1.stopbit;
//cdcb.XonChar:=char(1);
//cdcb.XoffChar:=char(1);
if not SetCommState(comhand,cdcb) then //配置串口
begin
memo1.lines.Add('无法配置串口属性');
CloseHandle(comhand);
exit;
end;
if (not SetCommMask(comhand,EV_RXCHAR)) then
begin
memo1.lines.Add('无法配置串口事件');
CloseHandle(comhand);
exit;
end;
comonoff:=1;
N9.Enabled:=false;
radiobutton2.Checked:=true;
radiobutton1.Enabled:=false;
edit1.Enabled:=false;
button1.Enabled:=false;
timer2.Enabled:=true;
memo1.Lines.Add('串口已经打开');
end //1
else
begin //2
try
CLoseHandle(comhand);
except
end;
timer2.Enabled:=true;
N9.Enabled:=true;
memo1.Lines.Add('串口已经关闭');
comonoff:=0;
radiobutton1.Enabled:=true;
edit1.Enabled:=true;
button1.Enabled:=true;
end; //2
end;
procedure TForm1.ToolButton4Click(Sender: TObject);
begin
memo1.Lines.Clear;
showstate('gggg');
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var //userinfo:get_user_at;
//usercount:get_max_user_amount;
//closeuser:do_close_one_user;
urcount:cardinal;
i,j:integer;
uistruct:gprs_user_info;
list:Tlistitem;
str1:string;
mess:arr;
begin
//取函数地址
//@usercount:=GetProcAddress(hand,'get_max_user_amount');
//@userinfo:=GetProcAddress(hand,'get_user_at');
//@closeuser:=GetProcAddress(hand,'do_close_one_user');
urcount:=function_get_max_user_amount;
if urcount=0 then exit;
listview1.Items.Clear;
for i:=0 to urcount-1 do
begin //1
function_get_user_at(i,@uistruct);
if uistruct.m_status=1 then
begin //1.1
str1:='';
//得到用户时间
for j:=1 to 19 do
str1:=str1+uistruct.m_update_time[j];
if is_datetime(str1) then
begin
//memo1.Lines.Add(floattostr(now-strtodatetime(str1)));
if now-strtodatetime(str1)>(0.00138889*timeinterval) then
begin
//memo1.Lines.Add(floattostr(now-strtodatetime(str1)));
function_do_close_one_user(@uistruct.m_userid[1],@mess[1]);
continue;
end;
end;
list:=listview1.Items.Add;
list.Caption:=uistruct.m_userid;
//strip.
list.SubItems.Add(inttoip(uistruct.m_local_addr));
list.SubItems.Add(inttostr(uistruct.m_local_port));
list.SubItems.Add(uistruct.m_logon_date);
list.SubItems.Add(inttoip(uistruct.m_sin_addr));
list.SubItems.Add(inttostr(uistruct.m_sin_port));
end; //1.1
end; //1
if (Form1.registerstyle=1) then
Form1.registerserver(5);
end;
function TForm1.is_datetime(str:string):boolean;
begin
try
strtodatetime(str);
is_datetime:=true;
except
is_datetime:=false;
end;
end;
procedure TForm1.ListView1Click(Sender: TObject);
begin
if listview1.ItemIndex>=0 then
edit2.text:=listview1.Selected.Caption;
end;
procedure TForm1.ToolButton3Click(Sender: TObject);
var //func:do_close_one_user;
mess:arr;
str:array[1..12] of char;
i:integer;
begin
if length(edit2.Text)<1 then exit;
//@func:=GetProcAddress(hand,'do_close_one_user');
for i:=1 to length(edit2.text) do
str[i]:=edit2.text[i];
if (i<12) then str[i]:=#0;
function_do_close_one_user(@str[1],@mess[1]);
Form1.Timer1Timer(Timer1);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if form1.ToolButton2.Enabled=true then
form1.ToolButton2Click(toolbutton2);
try
if (comonoff=1) then CloseHandle(comhand);
FreeLibrary(hand);
except
end;
end;
procedure TForm1.T1Click(Sender: TObject);
begin
if not t1.Checked then
begin
form1.FormStyle:=fsStayOnTop;
t1.Checked:=true;
end
else
begin
form1.FormStyle:=fsNormal;
t1.Checked:=false;
end;
end;
procedure TForm1.N11Click(Sender: TObject);
begin
application.CreateForm(tfabout,fabout);
fabout.ShowModal;
end;
procedure TForm1.A1Click(Sender: TObject);
begin
application.CreateForm(tfaccount,faccount);
faccount.ShowModal;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if MessageDlg('确认退出吗?',mtconfirmation,[MBYES,MBNO],0)=mrno then
canclose:=false;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
coms:TCOMSTAT;
clear:boolean;
perror:cardinal;
buf:array[1..1024] of char;
str:string;
i:integer;
rcount:cardinal;
readnum:integer;
begin
clear:=ClearCommError(form1.comhand,perror,@coms);
if not clear then begin exit; end;
if coms.cbInQue<=0 then begin exit; end;
//memo1.Lines.Add('cbinque='+inttostr(coms.cbInQue));
if coms.cbInQue<1024 then readnum:=coms.cbInQue
else readnum:=1024;
ReadFile(form1.comhand,buf,readnum,rcount,nil);
if rcount>0 then
begin
//memo1.Lines.Add('rcount='+inttostr(rcount)+':'+strtohexstr(buf,6));
str:='';
for i:= 1 to rcount do
str:=str+buf[i];
form1.Edit1.Text:=str;
form1.Button1Click(form1.Button1);
//form1.Edit1.Clear;
form1.Edit1.Text:='串口发送数据';
end;
end;
procedure TForm1.F1Click(Sender: TObject);
begin
application.CreateForm(tflog,flog);
flog.ShowModal;
end;
procedure TForm1.CheckBox4Click(Sender: TObject);
begin
if checkbox4.Checked then
begin
form1.F1.Enabled:=false;
form1.currentnum:=form1.logmaxcount;
end
else
begin
form1.F1.Enabled:=true;
end;
end;
procedure TForm1.I1Click(Sender: TObject);
begin
application.CreateForm(tfinterval,finterval);
finterval.ShowModal;
end;
procedure TForm1.N13Click(Sender: TObject);
begin
if not n13.Checked then n13.Checked:=true else n13.Checked:=false;
end;
procedure TForm1.R1Click(Sender: TObject);
begin
application.CreateForm(tfregister,fregister);
fregister.ShowModal;
end;
function TForm1.getipaddr(dmname:string):string;
var phe:PHostEnt;
resultstr:string;
wVersionRequired: Word;
WSData: TWSAData;
Status: Integer;
begin
wVersionRequired := MAKEWORD(1, 1);
Status := WSAStartup(wVersionRequired, WSData);
phe:=gethostbyname(pchar(dmname));
if phe=nil then begin getipaddr:=''; exit; end;
Resultstr:=Format('%d.%d.%d.%d',
[Byte(phe^.h_addr_list^[0]),Byte(phe^.h_addr_list^[1]),
Byte(phe^.h_addr_list^[2]),Byte(phe^.h_addr_list^[3])]);
wsacleanup();
getipaddr:=resultstr;
end;
procedure TForm1.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var rvbuf:array[1..128] of char;
i:integer;
ErrorCode:Integer;
begin
for i:=1 to 128 do
rvbuf[i]:=#0;
if NumberBytes>128 then
form1.NMUDP1.ReadBuffer(rvbuf,i)
else
form1.NMUDP1.ReadBuffer(rvbuf,NumberBytes);
if NumberBytes<>41 then exit;
ErrorCode:=Integer(rvbuf[40])+Integer(rvbuf[41])*256;
if ((rvbuf[1]=char($aa)) and (rvbuf[2]=char($29))) then
begin
if (ErrorCode=0) and (Integer(rvbuf[3])=$11) then Memo1.Lines.Add('***** 向服务器 www.mdtu.com 注册成功');
if (ErrorCode=1) and (Integer(rvbuf[3])=$11) then Memo1.Lines.Add('***** 向服务器 www.mdtu.com 注册失败:没有该序列号');
if (ErrorCode=2) and (Integer(rvbuf[3])=$11) then Memo1.Lines.Add('***** 向服务器 www.mdtu.com 注册成功:该序列号已被停用');
if (Integer(rvbuf[3])=$13) then Memo1.Lines.Add('***** 向服务器 www.mdtu.com 注销成功');
end;
end;
procedure TForm1.N14Click(Sender: TObject);
begin
Application.CreateForm(TFStart,FStart);
FStart.ShowModal;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
if Form1.StartType=1 then Form1.ToolButton1Click(ToolButton1);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -