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

📄 umain.~pas

📁 GPRS无线数据管理软件,用于远程数据采集和分析以及展现
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
   
   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 + -