unitcomm.pas

字模管理程序,为单片机程序汉字显示打印而制.无密码

    sb[15]:=hi(CtrCode)+addsub;
    for i:=0 to 5 do sb[i+5]:=meter_addr[i];
    addb:=0;
    for i:=4 to 15 do
        addb:=addb+sb[i];
    sb[16]:=addb;
    sb[17]:=$16;
    sb[18]:=$55;
    result:=SendData(sb,19,0);//前后各多发
end;
function  TComm.ReadMeter1(CtrCode:word;ty:integer;se:integer):boolean;   //负荷曲线bc14
var
    sb:array [0..255] of byte;
    addb:byte;
    Ls,L,i:integer;
begin
    sb[0]:=$fe; sb[1]:=$fe;sb[2]:=$fe;sb[3]:=$fe;
    sb[4]:=$68;sb[11]:=$68;
    sb[12]:=$01;sb[13]:=$04;
    sb[14]:=lo(CtrCode)+addsub;
    sb[15]:=hi(CtrCode)+addsub;
    sb[16]:=ty+addsub;
    sb[17]:=se+addsub;
    for i:=0 to 5 do sb[i+5]:=meter_addr[i];
    addb:=0;
    for i:=4 to 17 do
        addb:=addb+sb[i];
    sb[18]:=addb;
    sb[19]:=$16;
    sb[20]:=$55;
    result:=SendData(sb,21,0);//前后各多发
end;
function TComm.WaitReciveFormatforReadSet(var recibf:array of byte;RS:boolean):integer;
//返回　０：正常应答　　　-1:无应答，　　其它:应答状态字（可能没-33)
var
    rebuf:array [0..511] of byte;
    lenu:integer;
    rebf:array [0..255] of byte;
    len,i:integer;
    dwS,dwE:Dword;
//    tmps:string;
    inx:integer;
begin
    //RS:Read=false,Set=true;
                    Application.ProcessMessages;
    dwS:=GetTickCount;
    lenu:=0;
    result:=-1;         //超时返回值
    while true do begin
        dwE:=GetTickCount;
        if dwE-dwS >1000 then exit;
        len:=256;
        sleep(100);
        ReciData(rebf,len);
        for i:=0 to len-1 do begin
            if lenu>511 then lenu:=0;
            rebuf[lenu]:=rebf[i];
            lenu:=lenu+1;
        end;
        if lenu>=12+2 then  begin
            inx:=Sear68HBfinByteBufs(rebuf,lenu);
            if (inx<>-1) then  begin
                if  (((rebuf[inx+8] and $c0)=$80)) then begin
                    len:=lenu-inx-1;
                    if len>255 then len:=255;
                    for i:=0 to len do begin
                        if i<10 then recibf[i]:=rebuf[inx+i]
                        else  recibf[i]:=rebuf[inx+i]-addsub;
                    end;
                    result:=0;exit;
                end else begin
                    result:=-1;
                    if ((not RS) and (rebuf[inx+8]=$c1)) or ((RS) and (rebuf[inx+8]=$c4)) then result:=rebuf[inx+10];
                    exit;   //非正常应答返回
                end ;
            end;
        end;
        Application.ProcessMessages;
    end;
end;
function TComm.SendStr(Sstr:string):boolean;
var
    dwS,dwE:Dword;
begin
    result:=false;
    try
        if MSComm.PortOpen then
            MSComm.Output:=Sstr
        else exit;
        dwS:=GetTickCount;
        while true do begin
            dwE:=GetTickCount;
            if MSComm.OutBufferCount<=0 then break;
            if dwE-dwS >(100+1000*256/240) then begin  //baud 2400
                ShowCommInfo('发送超时！');
                exit;
            end;
        end;
    except
        on E:Exception do begin
            ShowCommInfo('串口有误:'+E.Message);
            exit;
        end;
    end;
    result:=true;
end;
function TComm.SendData(const sendbf:array of byte;const bflen:integer;intervalms:integer):boolean;
var
    ovTmp:Olevariant;
    vTmp:Variant;
    i:integer;
    dwS,dwE:Dword;
begin
   result:=false;
   try
    MSComm.InBufferCount:=0;
    MSComm.OutBufferCount:=0;
    if intervalms=0 then begin
        dwS:=GetTickCount;
        vTmp:=VarArrayCreate([0,bflen-1],VarByte);
        for i:=0 to bflen-1 do
            vTmp[i]:=Sendbf[i];
        ovTmp:=vTmp;
        MSComm.Output:=ovTmp;
        while true do begin
            dwE:=GetTickCount;
            if MSComm.OutBufferCount<=0 then break;
            if dwE-dwS >(1000+1000*bflen/240) then begin  //baud 2400
                ShowCommInfo('发送超时！');
                exit;
            end;
        end;
        ShowCommInfo('Send: '+convertbufto16str(Sendbf,bflen));
    end else begin
        vTmp:=VarArrayCreate([0,0],VarByte);
        for i:=0 to bflen-1 do  begin
            vTmp[0]:=Sendbf[i];
            ovTmp:=vTmp;
            MSComm.Output:=ovTmp;
            sleep(intervalms);
            dwS:=GetTickCount;
            while true do begin
                dwE:=GetTickCount;
                if MSComm.OutBufferCount<=0 then break;
                if dwE-dwS >(100+1000*1/240) then begin  //baud 2400
                    ShowCommInfo('发送超时！');
                    exit;
                end;
            end;
        end;
    end;
   except
    on E:Exception do begin
        ShowCommInfo('串口有误:'+E.Message);
        exit;
    end;
   end;
   result:=true;
end;
function TComm.ReciData(var recibf:array of byte;var bflen:integer):boolean;
var
    RebufLen:integer;
    ovTmp:Olevariant;
    vTmp:Variant;
    i:integer;
begin
    result:=false;
    RebufLen:=bflen;    //接收最长限制
    bflen:=0;
    sleep(500);
    if not (MSComm.PortOpen) then exit;
    try
        MSComm.InputMode:=ComInputModeBinary;
        bflen:=MSComm.InBufferCount;
        if bflen>0 then begin
            ovTmp:=MSComm.Input;
            vTmp:=VarArrayCreate([0,bflen+10],VarByte);
            vTmp:=ovTmp;
            if bflen>RebufLen then bflen:=RebufLen;
            for i:=0 to bflen-1 do  begin
                recibf[i]:=vTmp[i];
            end;
            ShowCommInfo('Reci: '+convertbufto16str(recibf,bflen));
        end;
    except
        on E: Exception do begin
            ShowCommInfo('串口接收有误:'+E.Message);
            exit;
        end;
    end;
    result:=true;
end;
function TComm.WaitRecive(reciflagbf:array of byte;rflagbflen:integer;rlastbflen:integer;TimeOutms:integer;var recibf:array of byte):boolean;
var
    rebuf:array [0..511] of byte;
    lenu:integer;
    rebf:array [0..255] of byte;
    len,i:integer;
    dwS,dwE:Dword;
//    tmps:string;
    inx:integer;
begin
    dwS:=GetTickCount;
    lenu:=0;
    while true do begin
        dwE:=GetTickCount;
        if dwE-dwS >TimeOutms then exit;
        len:=256;
        sleep(20);
        ReciData(rebf,len);
        for i:=0 to len-1 do begin
            if lenu>511 then lenu:=0;
            rebuf[lenu]:=rebf[i];
            lenu:=lenu+1;
        end;
        if lenu>=rflagbflen then begin
            inx:=SearChSBfinByteBufs(rebuf,lenu,reciflagbf,rflagbflen);
            if (inx<>-1) and (lenu-inx-rflagbflen>=rlastbflen) then begin
                len:=lenu-inx-1;
                if len>255 then len:=255;
                for i:=0 to len do recibf[i]:=rebuf[inx+i];
                result:=true;exit;
            end;
        end;
        Application.ProcessMessages;
    end;
    result:=false;
end;

procedure TComm.ShowCommInfo(Msg:string);
begin
    //可将Comm1换为其它对话框
    if MemoP1=nil then exit;
    if MemoP1^.Lines.Count>63 then begin
        if MemoP1^.Tag=1 then
            SaveCommLog(40);
        ClearCommInfo(40);
    end;
    if pos('--------',msg)<>1 then
        MemoP1^.Lines.Add(Msg+FormatDateTime('":"yyyy"-"MM"-"dd" "hh":"mm":"ss',now) )
     else
        MemoP1^.Lines.Add(Msg ) ;
end;
procedure TComm.ClearCommInfo(TopLine:integer);
var
    i:integer;
begin
    //可将Comm1换为其它对话框
    if TopLine=0 then
        MemoP1^.Clear
    else
        for i:=0 to Topline-1 do begin
            MemoP1^.Lines.Delete(0);
        end;
end;
procedure TComm.SaveCommLog(TopLine:integer);
var
    fPN:string;
    hF:TextFile;
    i:integer;
begin
    fpN:=FormatDateTime('"Comm"yyyy"年"MM"月"dd"日"',now);
    fpN:=ExtractFilePath(ParamStr(0))+fPN+'日志文件.txt';
  try
    AssignFile(hF,fPN);
    if not FileExists(fPN) then  ReWrite(hF);
    Append(hF);
    //可将Comm1换为其它对话框
    if TopLine=0 then
        WriteLn(hF,MemoP1^.text)
    else
        for i:=0 to Topline-1 do begin
            WriteLn(hF,MemoP1^.Lines[i]);
        end;
  finally
    Flush(hF);
    CloseFile(hF);
  end;
end;
procedure TComm.Button3Click(Sender: TObject);
begin
    OpenDialog1.Filter := 'Parameter文件(*.Mpr)|*.mpr|All files (*.*)|*.*';
    OpenDialog1.FileName:=getfilepath+'Parameter.Mpr';
    if OpenDialog1.Execute then if fileexists(OpenDialog1.FileName) then begin
        Edit2.Text:=OpenDialog1.FileName;
    end;
end;

procedure TComm.FormClose(Sender: TObject; var Action: TCloseAction);
var
    F: TextFile;
begin
        AssignFile(F,getfilepath+'Parameter.INI'); { File selected in dialog }
        Rewrite(F);
        writeln(F,Edit1.text);
        writeln(F,Edit2.text);
        closefile(f);
end;

procedure TComm.FormCreate(Sender: TObject);
var
    i:integer;
begin
    for i:=0 to 5 do comm.meter_addr[i]:=$99;
end;

end.