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

📄 main.~pas

📁 串口监控程序,可与UPS进行通信,适合初学者使用
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, Menus, StdCtrls, RzCmboBx, Buttons, ExtCtrls, ComCtrls,
  ToolWin, RzTabs, Mask, RzEdit,  DB, ADODB, SPComm;

type
  Tfmain = class(TForm)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    ImageList: TImageList;
    StatusBar1: TStatusBar;
    Panel2: TPanel;
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    TabSheet3: TRzTabSheet;
    TabSheet4: TRzTabSheet;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    RadioGroup1: TRadioGroup;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    RzEdit5: TRzEdit;
    RzEdit6: TRzEdit;
    RzEdit7: TRzEdit;
    RzEdit25: TRzEdit;
    RzEdit26: TRzEdit;
    RzEdit1: TRzEdit;
    RzEdit4: TRzEdit;
    RzEdit14: TRzEdit;
    RzEdit15: TRzEdit;
    RzEdit16: TRzEdit;
    RzEdit2: TRzEdit;
    RzEdit3: TRzEdit;
    RzEdit20: TRzEdit;
    RzEdit24: TRzEdit;
    RzEdit8: TRzEdit;
    RzEdit9: TRzEdit;
    RzEdit10: TRzEdit;
    RzEdit13: TRzEdit;
    RzEdit12: TRzEdit;
    RzEdit11: TRzEdit;
    RzEdit17: TRzEdit;
    RzEdit18: TRzEdit;
    RzEdit19: TRzEdit;
    RzEdit21: TRzEdit;
    RzEdit22: TRzEdit;
    RzEdit23: TRzEdit;
    GroupBox3: TGroupBox;
    Label6: TLabel;
    RzEdit27: TRzEdit;
    Label7: TLabel;
    RzEdit28: TRzEdit;
    Label14: TLabel;
    RzEdit29: TRzEdit;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    RzEdit30: TRzEdit;
    RzEdit31: TRzEdit;
    Label18: TLabel;
    Label19: TLabel;
    RzEdit32: TRzEdit;
    Label20: TLabel;
    Label21: TLabel;
    RzEdit33: TRzEdit;
    Label22: TLabel;
    Label23: TLabel;
    RzEdit34: TRzEdit;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    RzEdit35: TRzEdit;
    RzEdit36: TRzEdit;
    Label31: TLabel;
    Label32: TLabel;
    GroupBox4: TGroupBox;
    Label33: TLabel;
    Label34: TLabel;
    Label35: TLabel;
    Label36: TLabel;
    Label37: TLabel;
    Label38: TLabel;
    dbcon: TADOConnection;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Memo2: TMemo;
    Timer1: TTimer;
    Label27: TLabel;
    Label39: TLabel;
    Label40: TLabel;
    Comm1: TComm;
    Timer2: TTimer;
    Timer3: TTimer;
    Timer4: TTimer;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    BitBtn9: TBitBtn;
    BitBtn10: TBitBtn;
    BitBtn11: TBitBtn;
    BitBtn12: TBitBtn;
    Edit10: TEdit;
    Button5: TButton;
    recordtimer: TTimer;
    procedure ToolButton10Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure Timer4Timer(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure RzEdit5Change(Sender: TObject);
    procedure RzEdit8Change(Sender: TObject);
    procedure RzEdit13Change(Sender: TObject);
    procedure RzEdit16Change(Sender: TObject);
    procedure RzEdit17Change(Sender: TObject);
    procedure RzEdit21Change(Sender: TObject);
    procedure recordtimerTimer(Sender: TObject);


  private
    { Private declarations }
    function Result_Array(var  Try_Array:array  of  string) : string   ;
    function Result_Array1(var  Try_Array1:array  of  string) : string   ;
    function Result_Array2(var  Try_Array2:array  of  string) : string   ;

  public

    { Public declarations }
  end;

  function HexStrToStr(const S:string):string;
  function getsystypes:boolean;
  function setprivilege(sprivilegename: ansistring; benable: boolean): boolean ;
  Procedure setflash ;


var
  fmain: Tfmain;

  comopen:string='n';
 // 串口打开

      inputv,  mininputv,outputv,loadper,inputfre,batteryv,temperature,state:string;
  //输入电压,电压下限,输出电压, 负载,  输入频率,电池电压,温度,        状态
  rav,       raa,     rabatteryv,   raload:string;
//额定电压,额定电流,额定电池电压,额定频率
  company, spec,     ver:string;
//公司名称,UPS型号,版本

beeperon,shutdown,testin,upstype,upsfail,bypass,batterylow,utility:string;
//蜂鸣,   切断,    测试,  UPS状态,UPP失败,?,     市电


 //                               Q1        I(公司名称),F额定,T放试10,TL放电到低压
order:array[0..7] of   string=('51 31 0d','49 0d','46 0d','54 0d','54 4c 0d','43 54 0d','51 0d','43 0d');
                      //          CT撒消, Q开关报警,C撒消恢复开机


implementation

uses about,  check, parameter,workplan,data,event,emonth,control,closefile;

{$R *.dfm}

procedure Tfmain.ToolButton10Click(Sender: TObject);
begin
 close;
end;

procedure Tfmain.ToolButton9Click(Sender: TObject);
begin
 with tfabout.Create(nil) do
 begin
  showmodal;
  free;
 end;
end;

procedure Tfmain.ToolButton1Click(Sender: TObject);
begin
 with tfcheck.Create(nil) do
 begin
  showmodal;
  free;
 end;
end;

procedure Tfmain.ToolButton2Click(Sender: TObject);
begin
 with tfparameter.create(nil) do
  begin
   showmodal;
   free;
  end;
end;

procedure Tfmain.ToolButton3Click(Sender: TObject);
begin
    with tfworkplan.create(nil) do
  begin
   showmodal;
   free;
  end;
end;

procedure Tfmain.ToolButton4Click(Sender: TObject);
begin
  with tfdata.create(nil) do
  begin
  
   showmodal;
   free;
  end;
end;

procedure Tfmain.ToolButton5Click(Sender: TObject);
begin
  with tfevent.create(nil) do
  begin
   showmodal;
   free;
  end;
end;

procedure Tfmain.ToolButton7Click(Sender: TObject);
begin
 with tfcontrol.create(nil) do
  begin
   showmodal;
   free;
  end;
end;

procedure Tfmain.ToolButton6Click(Sender: TObject);
begin
  with tfemonth.create(nil) do
  begin
   showmodal;
   free;
  end;
end;

procedure Tfmain.ToolButton8Click(Sender: TObject);
begin
  with tfclosefile.create(nil) do
  begin
   showmodal;
   free;
  end;
end;

procedure Tfmain.FormCreate(Sender: TObject);
var
   dbfilename:string;

 qrytemp:tadoquery;

     Const
      connstr='Provider=Microsoft.Jet.OLEDB.4.0;'+
              'Data Source=%s;Persist Security Info=False;'+
              'Jet OLEDB:Database Password=%s';
begin
  comopen:='no';
    dbfilename:=extractfilepath(application.ExeName)+'db1.mdb';
  dbcon.ConnectionString:=format(connstr,[dbfilename,'']);



  try
 comm1.StartComm ;
 except ShowMessage('串口已经打开!');
 end;

 ////////////是否保存数据
 qrytemp:=tadoquery.Create(self);
  qrytemp.Connection :=fmain.dbcon ;
  qrytemp.SQL.Clear ;
  qrytemp.SQL.Text :='select intervalsave,intervaltime from user_set where type='+'''user_set''';
   qrytemp.open  ;
  recordtimer.Enabled :=qrytemp.FieldByName('intervalsave').AsBoolean and (comopen<>'no') ;
  recordtimer.Interval :=qrytemp.fieldbyname('intervaltime').AsInteger*1000 ;


  qrytemp.Close;
  qrytemp.Free ;


      if comopen='no' then
   begin
   fmain.BitBtn1.Visible :=true;
   fmain.Edit1.Enabled :=true;
   fmain.BitBtn7.Visible :=false;
   end
   else
   begin
    fmain.BitBtn1.Visible :=false;
    fmain.Edit1.Enabled :=false;
   fmain.BitBtn7.Visible :=true;
   end;

end;

procedure Tfmain.Button2Click(Sender: TObject);
begin
   Comm1.WriteCommData(Pchar(HexStrToStr(order[0])),Length(HexStrToStr(order[0])));
 //  sleep(3000) ;
 //  button3.Click ;  edit10.Text
end;

procedure Tfmain.Button3Click(Sender: TObject);
begin
   Comm1.WriteCommData(Pchar(HexStrToStr(order[2])),Length(HexStrToStr(order[2])));

end;

procedure Tfmain.Button4Click(Sender: TObject);
begin
    memo2.Clear ;
   Comm1.WriteCommData(Pchar(HexStrToStr(order[1])),Length(HexStrToStr(order[1])));


end;



function HexStrToStr(const S:string):string;
//16进制字符串转换成字符串
var
  t:Integer;
  ts:string;
  M,Code:Integer;
begin
  t:=1;
  Result:='';
  while t<=Length(S) do
  begin   //xlh 2006.10.21
    while (t<=Length(S)) and (not (S[t] in ['0'..'9','A'..'F','a'..'f'])) do
      inc(t);
    if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
      ts:='$'+S[t]
    else
      ts:='$'+S[t]+S[t+1];
    Val(ts,M,Code);
    if Code=0 then
      Result:=Result+Chr(M);
    inc(t,2);
  end;
end;



procedure Tfmain.Button1Click(Sender: TObject);
begin
if button1.Caption ='暂停' then
begin
Timer2.Enabled :=false;
Timer3.Enabled :=false;
Timer4.Enabled :=false;
button1.Caption :='开始'
end
else
begin
button1.Caption :='暂停';
Timer2.Enabled :=true;
Timer3.Enabled :=true;
Timer4.Enabled :=true;

end;

end;

procedure Tfmain.Timer1Timer(Sender: TObject);
begin
button1.Click ;
end;

procedure Tfmain.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
    var
  str:string;
  s:string;
  AA:array[0..15]   of   string;

begin
  SetLength(Str,BufferLength);
  move(buffer^,pchar(@Str[1])^,bufferlength);
  s:=copy(str,1,1);

  IF S='('    THEN
  begin

  aa[0]:=str;
  Result_Array(AA);

  inputv:=aa[0];
  mininputv:=aa[1];
  outputv:=aa[2];
  loadper:=aa[3];
  inputfre:=aa[4];
  batteryv:=aa[5];
  temperature:=aa[6];
  state:=aa[7];
  beeperon:=aa[8];

  shutdown:=aa[9];
  testin:=aa[10];
  upstype:=aa[11];
  upsfail:=aa[12];
  bypass:=aa[13];
  batterylow:=aa[14];
  utility:=aa[15];

   RzEdit5.Text  := inputv;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -