📄 umain.~pas
字号:
for i:=1 to 4 do showstr:=showstr+rvdata.m_data_buf[i];
form1.showstate(showstr);
end;
panel2.Caption:=inttostr(strtoint(panel2.Caption)+1);
end;
procedure TForm1.showstate2;
var i:integer;
showshape:array[1..16] of integer;
begin
for i:=0 to form1.ComponentCount-1 do
begin
if (form1.Components[i] is Tshape) then
showshape[(form1.Components[i] as Tshape).Tag]:=i;
end;
for i:=1 to 16 do
begin
if form1.lightonoff=i then
begin
(form1.Components[showshape[i]] as Tshape).Brush.Color:=clLime;
continue;
end;
(form1.Components[showshape[i]] as Tshape).Brush.Color:=form1.Panel1.Color;
end;
lightonoff:=lightonoff+1;
if lightonoff>16 then lightonoff:=1;
end;
procedure TForm1.showstate(str:string);
var numberset:array[1..16] of char;
showshape:array[1..16] of integer;
onoff:array[1..16] of integer;
indexch:array[1..16] of integer;
i,j:integer;
begin
if length(str)<4 then
begin
exit;
end;
for i:=0 to form1.ComponentCount-1 do
begin
if (form1.Components[i] is Tshape) then
showshape[(form1.Components[i] as Tshape).Tag]:=i;
end;
numberset[1]:='1';numberset[2]:='2';numberset[3]:='3';numberset[4]:='4';
numberset[5]:='5';numberset[6]:='6';numberset[7]:='7';numberset[8]:='8';
numberset[9]:='9';numberset[10]:='A';numberset[11]:='B';numberset[12]:='C';
numberset[13]:='D';numberset[14]:='E';numberset[15]:='F';numberset[16]:='0';
indexch[1]:=1;indexch[2]:=10;indexch[3]:=11;indexch[4]:=100;
indexch[5]:=101;indexch[6]:=110;indexch[7]:=111;indexch[8]:=1000;
indexch[9]:=1001;indexch[10]:=1010;indexch[11]:=1011;indexch[12]:=1100;
indexch[13]:=1101;indexch[14]:=1110;indexch[15]:=1111;indexch[16]:=0;
for i:=1 to 16 do onoff[i]:=2;
for i:=1 to 4 do
begin
for j:=0 to 16 do
if upcase(str[i])=numberset[j] then
begin
onoff[1+(i-1)*4]:=indexch[j] div 1000;
onoff[2+(i-1)*4]:=(indexch[j] mod 1000) div 100;
onoff[3+(i-1)*4]:=(indexch[j] mod 100) div 10;
onoff[4+(i-1)*4]:=(indexch[j] mod 10) div 1;
end;
end;
for i:=1 to 16 do
if onoff[i]=1 then (form1.Components[showshape[i]] as Tshape).Brush.Color:=form1.oncolor
else if onoff[i]=0 then (form1.Components[showshape[i]] as Tshape).Brush.Color:=form1.offcolor
else (form1.Components[showshape[i]] as Tshape).Brush.Color:=form1.errorcolor;
end;
function TForm1.inttoip(ip:cardinal):string;
var s:string;
begin
s:='';
s:=s+inttostr(ip div (256*256*256));
s:=s+'.';
s:=s+inttostr((ip div (256*256)) mod 256);
s:=s+'.';
s:=s+inttostr((ip div 256) mod 256);
s:=s+'.';
s:=s+inttostr(ip mod 256);
inttoip:=s;
end;
function TForm1.strtohex(str:string):string;
var i:integer;
s:string;
value:integer;
begin
if length(str)<2 then begin strtohex:=''; exit; end;
s:='';
for i:=1 to (length(str) div 2) do
begin
value:=0;
value:=stoi(str[i*2-1])*16+stoi(str[i*2]);
s:=s+chr(value);
end;
strtohex:=s;
end;
function TForm1.stoi(ch:char):integer;
var table:array[0..16] of char;
i:integer;
begin
table[0]:='0';table[1]:='1';table[2]:='2';table[3]:='3';
table[4]:='4';table[5]:='5';table[6]:='6';table[7]:='7';
table[8]:='8';table[9]:='9';table[10]:='A';table[11]:='B';
table[12]:='C';table[13]:='D';table[14]:='E';table[15]:='F';
table[16]:='X';
for i:=0 to 16 do
begin
if upcase(ch)=table[i] then break;
end;
stoi:=i;
end;
function TForm1.legalchar(ch:char):boolean;
begin
if ((ch>='0') and (ch<='9'))
or ((ch>='a') and (ch<='f'))
or ((ch>='A') and (ch<='Z'))
then legalchar:=true
else legalchar:=false;
end;
function TForm1.userintable(str:string):boolean;
begin
//
end;
function TForm1.strtohexstr(str:string;lenstr:integer):string;
var i,len:integer;
str1:string;
begin
str1:='';
len:=lenstr;
for i:=1 to len do
begin
str1:=str1+inttohex(integer(str[i]),2);
str1:=str1+' ';
end;
strtohexstr:=str1;
end;
procedure TForm1.registerserver(cmd:integer);
var sbuf:array[1..64] of char;
i:integer;
begin
if (Form1.SerialNo<1)
or (Length(Form1.ExtendSerialNo)<>32)
or (Length(Form1.serverIP)<7)
or (Form1.serverport<1024) then exit;
sbuf[1]:=char($aa);
sbuf[2]:=char($29);
case cmd of
1:
sbuf[3]:=char($01); //login
2:
sbuf[3]:=char($02); //logout
5:
sbuf[3]:=char($05); //report
end;
sbuf[4]:=Char(Form1.SerialNo mod 256);
sbuf[5]:=Char((Form1.SerialNo mod (256*256)) div 256);
sbuf[6]:=Char((Form1.SerialNo div (256*256)) mod 256);
sbuf[7]:=Char(Form1.SerialNo div (256*256*256));
for i:=1 to 32 do
sbuf[7+i]:=Form1.ExtendSerialNo[i];
{ ShowMessage(IntToStr(Integer(sbuf[4]))
+':'+IntToStr(Integer(sbuf[5]))
+':'+IntToStr(Integer(sbuf[6]))
+':'+IntToStr(Integer(sbuf[7])));
}
sbuf[40]:=char(Form1.sport mod 256);
sbuf[41]:=char(Form1.sport div 256);
Form1.NMUDP1.RemoteHost:=Form1.serverIP;
Form1.NMUDP1.RemotePort:=Form1.serverport;
Form1.NMUDP1.SendBuffer(sbuf,41);
end;
procedure TForm1.writeinifile(cmd:integer);
var buf:array[1..64]of char;
len,i:integer;
temp:string;
begin
case cmd of
1:
begin
{
form1.SerialNo:=0;
form1.ExtendSerialNo:='';
form1.serverip:='';
form1.serverport:=0;
form1.registerstyle:=2;
form1.StartType:=1;
}
len:=getprivateprofilestring('SYSTEM','SERIALNO','11',@buf[1],32,'registerserver.ini');
temp:='';
for i:=1 to len do
temp:=temp+buf[i];
try
Form1.SerialNo:=StrToInt(temp);
except
Exit;
end;
len:=getprivateprofilestring('SYSTEM','EXTENDSERIALNO','11',@buf[1],64,'registerserver.ini');
if (len<>32) then exit;
form1.ExtendSerialNo:='';
for i:=1 to len do
form1.ExtendSerialNo:=form1.ExtendSerialNo+buf[i];
len:=getprivateprofilestring('SYSTEM','SERVERIP','11',@buf[1],32,'registerserver.ini');
if (len<7) then exit;
for i:=1 to len do
form1.serverip:=serverip+buf[i];
len:=getprivateprofilestring('SYSTEM','SERVERPORT','11',@buf[1],32,'registerserver.ini');
if (len<4) then exit;
temp:='';
for i:=1 to len do
temp:=temp+buf[i];
form1.serverport:=strtoint(temp);
len:=getprivateprofilestring('SYSTEM','REGISTERSTYLE','',@buf[1],32,'registerserver.ini');
if (len<1) then exit;
form1.registerstyle:=strtoint(buf[1]);
len:=getprivateprofilestring('SYSTEM','STARTTYPE','',@buf[1],32,'registerserver.ini');
if (len<1) then exit;
form1.StartType:=strtoint(buf[1]);
end;
//write ini file
2:
begin
writeprivateprofilestring('SYSTEM','SERIALNO',pchar(IntToStr(form1.serialNO)),'registerserver.ini');
writeprivateprofilestring('SYSTEM','EXTENDSERIALNO',pchar(form1.ExtendSerialNO),'registerserver.ini');
writeprivateprofilestring('SYSTEM','SERVERIP',pchar(form1.serverIP),'registerserver.ini');
writeprivateprofilestring('SYSTEM','SERVERPORT',pchar(inttostr(form1.serverport)),'registerserver.ini');
writeprivateprofilestring('SYSTEM','REGISTERSTYLE',pchar(inttostr(form1.registerstyle)),'registerserver.ini');
writeprivateprofilestring('SYSTEM','STARTTYPE',pchar(inttostr(form1.StartType)),'registerserver.ini');
end;
else
;
end;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
close;
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
var
//func:start_server;
wnd:HWND;
buf:arr;
retval:integer;
begin
wnd:=form1.Handle;
hand:=LoadLibrary('gprs_dll.dll'); //打开动态链接库
if (hand=0) then
begin
memo1.lines.Add('无法载入 gprs_dll.dll 文件');
exit;
end;
@function_start_gprs_server:=GetProcAddress(hand,'start_gprs_server'); //取得启动服务函数的地址
@function_stop_gprs_server:=GetProcAddress(hand,'stop_gprs_server');
@function_do_read_proc:=GetProcAddress(hand,'do_read_proc');
@function_do_send_user_data:=GetProcAddress(hand,'do_send_user_data');
@function_do_close_one_user:=GetProcAddress(hand,'do_close_one_user');
@function_do_close_all_user:=GetProcAddress(hand,'do_close_all_user');
@function_get_user_at:=GetProcAddress(hand,'get_user_at');
@function_get_max_user_amount:=GetProcAddress(hand,'get_max_user_amount');
if (@function_start_gprs_server=nil) then
begin
FreeLibrary(hand);
memo1.lines.Add('取不到 get start_gprs_server 地址');
exit;
end;
retval:=function_start_gprs_server(wnd,msg,sport,@buf[1]); //启动服务
if retval<0 then
begin
FreeLibrary(hand);
memo1.Lines.add('GPRS/CDMA 数据服务中心启动失败');
exit;
end;
memo1.Lines.Add(buf);
toolbutton1.Enabled:=false;
toolbutton2.Enabled:=true;
n2.Enabled:=false;
n3.Enabled:=true;
timer1.Enabled:=true;
form1.StatusBar1.Panels[1].Text:='服务开始';
toolbutton3.Enabled:=true;
panel2.Caption:='0';
t1.Enabled:=false;
form1.currentnum:=form1.logmaxcount;
//register
if form1.registerstyle=1 then
form1.registerserver(1);
end;
procedure TForm1.ToolButton2Click(Sender: TObject);
var buf:arr;
//func_stop_server:stop_server;
//func_close_all_user:close_all_user;
i:integer;
begin
if MessageDlg('确认要停止服务吗？',mtconfirmation,[mbyes,mbno],0)=mrno then exit;
for i:=1 to 256 do
buf[i]:=#0;
//取得关闭用户函数的地址
//@func_close_all_user:=GetProcAddress(hand,'do_close_all_user');
if (@function_do_close_all_user=nil) then //判断是否取到该函数地址
begin
memo1.lines.Add('无法取得 do_close_all_user 地址');
exit;
end;
//取得停止服务的函数的地址
//@func_stop_server:=GetProcAddress(hand,'stop_gprs_server');
if (@function_stop_gprs_server=nil) then //判断是否取到该函数地址
begin
memo1.lines.Add('无法取得 stop_gprs_server 地址');
exit;
end;
try
function_do_close_all_user(@buf[1]); //关闭全部用户
memo1.Lines.Add(buf);
function_stop_gprs_server(@buf[1]); //停止服务
memo1.Lines.Add(buf);
if (comonoff=1) then CloseHandle(comhand); //关闭串口
FreeLibrary(hand); //释放动态库
except
end;
//showmessage('aaaaaaaaa');
listview1.Items.Clear;
toolbutton2.Enabled:=false;
toolbutton1.Enabled:=true;
n3.Enabled:=false;
n2.Enabled:=true;
timer1.Enabled:=false;
form1.StatusBar1.Panels[1].Text:='服务停止';
toolbutton3.Enabled:=false;
t1.Enabled:=true;
if form1.registerstyle=1 then
form1.registerserver(2);
end;
procedure TForm1.IP1Click(Sender: TObject);
var str:string;
begin
str:=inputbox('输入框','请输入端口(1000~65535) ',inttostr(form1.sport));
try
form1.sport:=strtoint(str);
except
memo1.lines.Add('端口错误');
str:=inputbox('输入框','请输入端口',inttostr(form1.sport));
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
if (form1.Width-472>72) then
panel2.Width:=form1.Width-472;
form1.lognamepath:=NO_DIRECTORY;
form1.logmaxcount:=1000;
form1.currentnum:=1000;
timeinterval:=3;
lightonoff:=1;
msg:=4567;
oncolor:=cllime;
offcolor:=clRed;
errorcolor:=form1.Panel1.Color;
//initialize COM
form1.baudrate:=CBR_57600;
form1.comnum:=1;
form1.databit:=8;
form1.stopbit:=ONESTOPBIT;
form1.parity:=NOPARITY;
form1.commstate[1]:=0;
form1.commstate[2]:=8;
form1.commstate[3]:=2;
form1.commstate[4]:=3;
form1.commstate[5]:=0;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -