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

📄 unit1.pas

📁 这是一个用delphi7.0 编写的P串口通讯程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
🔍
12 
unit Unit1;

interface

uses
  inifiles,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, MSCommLib_TLB, IdTrivialFTPBase, ExtCtrls;
  // ShockwaveFlashObjects_TLB;
const
  // added for one instance, called from message handler
  CM_RESTORE = WM_USER + $300;


type
  pkbytearray=array[1..512] of byte;
  TForm1 = class(TForm)
    GroupBox2: TGroupBox;
    Button4: TButton;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Label6: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Memo2: TMemo;
    Button5: TButton;
    Edit4: TEdit;
    Label9: TLabel;
    Button6: TButton;
    CheckBox1: TCheckBox;
    Label10: TLabel;
    Memo3: TMemo;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Timer1: TTimer;
    Button15: TButton;
    Button16: TButton;
    Button18: TButton;
    Label19: TLabel;
    Label20: TLabel;
    Label30: TLabel;
    MSComm2: TMSComm;
    procedure processcommand(it:integer);
    //procedure MSComm1Comm(Sender: TObject);
   // procedure FormCreate(Sender: TObject);
    //procedure Button1Click(Sender: TObject);
   // procedure Button2Click(Sender: TObject);
   // procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button4_11Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    //procedure Button7Click(Sender: TObject);
   // procedure Button8Click(Sender: TObject);
    procedure MSComm2Comm(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
   // procedure Button12Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
   // procedure Button13Click(Sender: TObject);
   // procedure Button15Click(Sender: TObject);
   // procedure Button16Click(Sender: TObject);
    //procedure Button17Click(Sender: TObject);
   // procedure Button18Click(Sender: TObject);
   // procedure Button19Click(Sender: TObject);
   // procedure Button14Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
        function getfilePath:string;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
  public
    { Public declarations }
    procedure sendbyte(bb: byte);
    procedure sendbuf(buf:array of byte;size:integer);
  end;
procedure generatecrc(var scode:pkbytearray;const iLen:integer);
procedure generatecrc1(var scode:pkbytearray;const iLen:integer);
function  byteto2xstr(c:byte):string;
function  bytetoword(c:byte):word;
function  byteltoword(c:byte):word;

var
  Form1: TForm1;
  bytebf:array [0..1024] of byte ;
  jjgg:array[0..1024] of Dword;
  dwsendEnd,dwsendstart:Dword;
  dwsendEnd2,dwsendstart2:Dword;
  bfrelen:integer;
  displen:integer;
  fullsend,com2open:boolean;
  inoncom:boolean;
  myini:tinifile;


implementation
{$R *.dfm}

uses Unit2;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WinClassName := 'comp';
end; {- o }
procedure TForm1.RestoreRequest(var message: TMessage);
begin
  if IsIconic(Application.Handle) = TRUE then
     Application.Restore
  else Application.BringToFront;
end; {- o }

function tform1.getfilePath:string;
var
 PathName:string;
begin
 PathName:=extractfilepath(application.ExeName);
 getfilePath:=pathname;
end;

function  byteto2xstr(c:byte):string;
var
    s:string;
    cc:integer;
begin
    asm
    mov eax,0
    mov al,c
    mov cc,eax
    end;
    s:=format('%2x',[cc]);
    if s[1]=' ' then s[1]:='0';
    byteto2xstr:=s;
end;


{procedure TForm1.MSComm1Comm(Sender: TObject);
var
    ren:integer;
    ovTmp:Olevariant;
    vTmp:variant;
    bTmp:byte;
    i:integer;
    jjggg:Dword;
begin
    if inoncom then exit;
    inoncom:=true;
//    if MSComm1.CommEvent=2 then begin
        ren:=MSComm1.InBufferCount;
        if ren>0 then begin
        ovTmp:=form1.MSComm1.Input;
                   vTmp:=vararraycreate([0,ren],varbyte);
                   vTmp:=ovTmp;
                   if bfrelen=0 then  begin
                         dwsendstart:=GetTickCount;
                         jjggg:=0;
                   end else  begin
                         dwsendEnd:=GetTickCount;
                         jjggg:=dwsendEnd-dwsendstart;
                         if jjggg>5000 then begin
                                jjggg:=5000;
                                dwsendstart:=dwsendEnd-5000;
                         end;
                   end;
                   for i:=0 to ren-1 do begin
                        bTmp:=vTmp[i];
                        bytebf[bfrelen]:=bTmp;
                        jjgg[bfrelen]:=jjggg;
                        inc(bfrelen);
                        if bfrelen>1020 then begin
                                bfrelen:=0;
                        end;
                   end;
                   button4.Enabled:=true;
                   button11.Enabled:=true;
//                   button12.Enabled:=true;
        end;
//    end;
    inoncom:=false;
end;     }

procedure TForm1.FormCreate(Sender: TObject);
var
        inifn:string;
        cv:integer;
begin
    setPriorityClass(Application.Handle,HIGH_PRIORITY_CLASS);
    inifn:=getfilepath+'comp.ini';
    myini:=tinifile.Create(inifn);
    bfrelen:=0;
    displen:=0;
    com2open:=false;
    inoncom:=false;
    button9.Enabled:=true;
    button10.Enabled:=false;
   // button1.Enabled:=true;
    //button2.Enabled:=false;
    button4.Enabled:=false;
    button11.Enabled:=false;
//    button12.Enabled:=false;

     //edit1.Text:=myini.ReadString('EDIT','1','2');
    // edit2.Text:=myini.ReadString('EDIT','2','38400,n,8,1');
     edit3.Text:=myini.ReadString('EDIT','3','1');
     edit4.Text:=myini.ReadString('EDIT','4','85');
    // edit5.Text:=myini.ReadString('EDIT','5','1');
    // edit6.Text:=myini.ReadString('EDIT','6','10');
     //edit7.Text:=myini.ReadString('EDIT','7','0');
     //edit8.Text:=myini.ReadString('EDIT','8','1');
     comboBox1.ItemIndex:=myini.ReadInteger('COMBOBOX','1',0);
     comboBox2.ItemIndex:=myini.ReadInteger('COMBOBOX','2',0);
    // comboBox3.ItemIndex:=myini.ReadInteger('COMBOBOX','3',0);
    // comboBox4.ItemIndex:=myini.ReadInteger('COMBOBOX','4',0);
    // comboBox5.ItemIndex:=myini.ReadInteger('COMBOBOX','5',0);
    // comboBox6.ItemIndex:=myini.ReadInteger('COMBOBOX','6',0);
     cv:=myini.ReadInteger('CHECKBOX','1',1);
     case  cv of
        0:checkBox1.State:=cbUnchecked;
        1: checkBox1.State:=cbChecked;
     else checkBox1.State:=cbUnchecked;
     end;
     cv:=myini.ReadInteger('CHECKBOX','2',0);
     case  cv of
        0:checkBox2.State:=cbUnchecked;
        1: checkBox2.State:=cbChecked;
     else checkBox2.State:=cbUnchecked;
     end;
end;

{procedure TForm1.Button1Click(Sender: TObject);
begin
     MSComm1.Settings:=edit2.Text;
     MSComm1.CommPort:=strtoint(edit1.Text);
     MSComm1.InputMode:=ComInputModeBinary;
    MSComm1.InBufferCount:=0;
    MSComm1.InputLen:=0;
    MSComm1.RThreshold:=strtoint(edit8.Text);              //每次接到字符就产生onComm事件
     memo1.Text:='';
     bfrelen:=0;
     displen:=0;
     button4.Enabled:=false;
     button11.Enabled:=false;
     MSComm1.PortOpen:=true;
     if ComboBox3.Text='ON高电平' then MSComm1.DTREnable:=TRUE
     else MSComm1.DTREnable:=false;
     if ComboBox4.Text='ON高电平' then MSComm1.RTSEnable:=TRUE
     else MSComm1.RTSEnable:=false;
     button2.Enabled:=true;
     button1.Enabled:=false;
//     button12.Enabled:=false;
end;  }

{procedure TForm1.Button2Click(Sender: TObject);
begin
    MSComm1Comm(nil);
     button1.Enabled:=true;
     button2.Enabled:=false;
    MSComm1.PortOpen:=false;
    MSComm1.DTREnable:=false;
    MSComm1.RTSEnable:=false;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//    ShockwaveFlash1.Movie:='C:\Program Files\Globallink\Game\share\Advert\nike.swf';
    form2.ShowModal;
end; }
procedure TForm1.Button4Click(Sender: TObject);
begin
        fullsend:=false;
        Button4_11Click(Sender);
end;
procedure TForm1.Button4_11Click(Sender: TObject);
var
  i:integer;
  vTmp:Variant;
  ovTmp:Olevariant;
  candisp:boolean;
begin
   Button10Click(Sender);        //关闭串口 下面再开似乎无用 可实践看更可靠，可能某线长时间不发一变低电平了
   if (not com2open) then begin
     MSComm2.Settings:=edit2.Text;
     MSComm2.CommPort:=strtoint(edit3.Text);
     MSComm2.InputMode:=ComInputModeBinary;
     try
     MSComm2.PortOpen:=true;
     except
      on E:Exception do begin
        MessageDlg('串口打不开，请关闭其它应用程序.', mtInformation,[mbOk], 0);
        MSComm2.PortOpen:=false;
        exit;
      end;
     end;
     if ComboBox1.Text='ON高电平' then MSComm2.DTREnable:=TRUE
     else MSComm2.DTREnable:=false;
     if ComboBox2.Text='ON高电平' then MSComm2.RTSEnable:=TRUE
     else MSComm2.RTSEnable:=false;
   end;
     com2open:=True;
     button9.Enabled:=false;
     button10.Enabled:=true;
     sleep(200);
     if  checkbox1.State=cbChecked then candisp:=true
     else   candisp:=false;
     if fullsend then begin
        vTmp:=vararraycreate([0,bfrelen-1],varbyte);
        for i:=0 to bfrelen-1 do  begin
             vtmp[i]:=bytebf[i];
             if  candisp then
                   memo2.Text:=memo2.Text+byteto2xstr(bytebf[i])+' ';
        end;
        ovTmp:=vTmp;
        form1.MSComm2.Output:=ovTmp;
     end else begin
    dwsendstart:=GetTickCount;
    vTmp:=vararraycreate([0,0],varbyte);
    for i:=0 to bfrelen-1 do  begin
        vtmp[0]:=bytebf[i];
        ovTmp:=vTmp;
        if  candisp then
                memo2.Text:=memo2.Text+byteto2xstr(bytebf[i])+' ';
        while jjgg[i]>GetTickCount-dwsendstart do begin
                asm
                        nop;
                end;
        end;
        form1.MSComm2.Output:=ovTmp;
    end;
      end;
    sleep(50);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
        memo2.Text:='';
        memo3.Text:='';
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  i,j:integer;
  vTmp:Variant;
  ovTmp:Olevariant;
  vword:integer;
  vbyte,b:byte;
const
        head:array [0..4] of byte=($55,$ff,$ff,$ff,$55);  //first $55 nouse 
begin
     vword:=StrToint(edit4.Text);
     asm
        mov eax,vword
        mov vbyte,al
     end;
   Button10Click(Sender);        //关闭串口 下面再开似乎无用 可实践看更可靠，可能某线长时间不发一变低电平了
    if not com2open then begin
     MSComm2.Settings:=edit2.Text;
     MSComm2.CommPort:=strtoint(edit3.Text);
     MSComm2.InputMode:=ComInputModeBinary;
     try
     MSComm2.PortOpen:=true;
     except
      on E:Exception do begin
        MessageDlg('串口打不开，请关闭其它应用程序.', mtInformation,[mbOk], 0);
        MSComm2.PortOpen:=false;
        exit;
      end;
     end;
    end;
     com2open:=True;
     button9.Enabled:=false;
     button10.Enabled:=true;

     if ComboBox1.Text='ON高电平' then MSComm2.DTREnable:=TRUE
     else MSComm2.DTREnable:=false;
     if ComboBox2.Text='ON高电平' then MSComm2.RTSEnable:=TRUE
     else MSComm2.RTSEnable:=false;
     sleep(500);
//    sendbuf(head,5);
    if vbyte=177 then
            for i:=0 to 24*8-1 do  sendbyte(byte(i))
    else
            for i:=0 to 24*8-1 do  sendbyte(vbyte);
    sleep(500);
end;
Procedure TForm1.sendbyte(bb: byte);
var
  j:integer;
  vTmp:Variant;
  ovTmp:Olevariant;
  b:byte;
begin
        b:=bb;
        vTmp:=vararraycreate([0,0],varbyte);
        vtmp[0]:=b;
{        vTmp:=vararraycreate([0,7],varbyte);
        for j:=0 to 7 do begin
                if (b and $80)=$80 then
                        vtmp[j]:=byte($55)
                else
                        vtmp[j]:=byte($00);
                b:=byte(b shl 1);
        end;
}        ovTmp:=vTmp;
        form1.MSComm2.Output:=ovTmp;
end;
procedure TForm1.sendbuf(buf:array of byte;size:integer);
var
     i:integer;
begin
        for i:=0 to size-1 do sendbyte(buf[i]);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
   f:TfileStream;
begin
    if bfrelen<=0 then exit;
    SaveDialog1.Filter := 'CMP文件(*.CMP)|*.cmp|All files (*.*)|*.*';
    if SaveDialog1.Execute then begin
        if extractfileext(SaveDialog1.FileName)='' then SaveDialog1.FileName:=ChangeFileext(SaveDialog1.FileName,'.cmp');
        f:=Tfilestream.Create(SaveDialog1.FileName,fmcreate);
        f.Write(bytebf,bfrelen);
        f.Destroy;
        label21.Caption:=  SaveDialog1.FileName;
        SaveDialog1.FileName:=ChangeFileext(SaveDialog1.FileName,'.CMT');
        f:=Tfilestream.Create(SaveDialog1.FileName,fmcreate);
        f.Write(jjgg,(bfrelen+1)*sizeof(DWord));
        f.Destroy;
    end;
end;

{procedure TForm1.Button8Click(Sender: TObject);
var
   f:TfileStream;
   i,ri:integer;
   b:array [0..5] of byte ;
   w:array [0..5] of DWord ;
begin
 opendialog1.Filter := 'CMP文件(*.CMP)|*.cmp|All files (*.*)|*.*';
   if opendialog1.execute then
     BEGIN
        if fileexists(opendialog1.FileName) then begin
        memo1.Text:='';
        f:=Tfilestream.Create(opendialog1.FileName,fmOpenReadWrite);
        i:=0;
        while f.Read(b,1)=1 do begin
                bytebf[i]:=b[0];
                memo1.Text:=memo1.Text+byteto2xstr(b[0])+' ';;
                i:=i+1;
        end;
        f.Destroy;
        end else  begin
                exit;
        end;
        opendialog1.FileName:=ChangeFileext(opendialog1.FileName,'.CMT');

        if fileexists(opendialog1.FileName) then begin
        f:=Tfilestream.Create(opendialog1.FileName,fmOpenReadWrite);
        i:=0;
        while  f.read(w,sizeof(DWord))=sizeof(DWord) do begin
                jjgg[i]:=w[0];
                i:=i+1;
        end;
        f.Destroy;
        if i>=1 then begin
                bfrelen:=i-1;
                displen:=i-1;
                button4.Enabled:=true;
                button11.Enabled:=true;
                label21.Caption:=  OpenDialog1.FileName;
        end else begin
                bfrelen:=0;
                displen:=0;
                memo1.Text:='';
        end;
        end else begin
                memo1.Text:='';
        end;
     END;
end;   }

procedure TForm1.MSComm2Comm(Sender: TObject);
var
//
    ren:integer;
    ovTmp:Olevariant;
    vTmp:Variant;
    bTmp:byte;
    i:integer;
begin
    if MSComm2.CommEvent=2 then begin
        ren:=MSComm2.InBufferCount;
        if ren>0 then begin
                  ovTmp:=form1.MSComm2.Input;
12

⌨️ 快捷键说明

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