publicfuctionu.pas

在delphi下对串口编程,实现与下位计的通信,并实时接收下位计数据,并保存到数据库中

unit publicfuctionu;

interface
 uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
        StdCtrls, ExtCtrls,db,comobj;
procedure  writetoexcel(bm:tdataset);
procedure  gxcsz(csmc:string);//该写参数值
function   qcsz(x:integer;csmc:string):string;//取参数值
function convChinese(sz:string):string;
function qzbxlh:string;//取主板序列号
function qwjmc:string;//取微机名称
function qmc(bm:string;bh:string;bhmc:string;dwmc:string):string;//取名称
function qbh(bm:string;mc:string;dwmc:string;bhmc:string):string;//取编号
function jm(zfc:string):string;//加密
function qsj():tdatetime;
function qny(fwqsj:tdatetime):string;
function qdkcs(csmc:string):string;//取端口参数
procedure xdkcs(csmc:string;csz:string);//写端口参数
implementation
  uses dmu;
  var app:olevariant;
procedure  writetoexcel(bm:tdataset);
  var jls0,zds0:integer;
      i,j:integer;
  begin
    app:=createoleobject('excel.application');
    app.visible:=true;
    app.workbooks.add;
    zds0:=bm.fieldcount;
    jls0:=bm.recordcount;
    bm.first;
    for i:=1 to zds0 do
      begin
       app.cells(1,i):=bm.fields[i-1].FieldName;
      end;
    for i:=2 to jls0+1 do
      begin
        for  j:=1 to zds0 do
          begin
            app.cells(i,j):=bm.fields[j-1].asstring;
          end;
        bm.Next;
      end;
  end;
function qdkcs(csmc:string):string;//取端口参数
  var str0:string;
  begin
    str0:='select 参数值 from 系统设置  where 参数名称='''+csmc+'''';
    with dm do
      begin
        query1.Close;
        query1.SQL.Clear;
        query1.SQL.Add(str0);
        query1.Open;
        result:=query1.fieldbyname('参数值').asstring;
      end;
  end;
procedure xdkcs(csmc:string;csz:string);//写端口参数
  var str0:string;
  begin
    str0:='select 参数值  from 系统设置  where 参数名称='''+csmc+'''';
    with dm do
      begin
        query1.Close;
        query1.SQL.Clear;
        query1.SQL.Add(str0);
        query1.Open;
        if query1.RecordCount<1 then
          begin
            str0:='insert into 系统设置 values ('''+csz+''','''+csmc+''')';
            query1.Close;
            query1.SQL.Clear;
            query1.SQL.Add(str0);
            query1.ExecSQL;
          end
        else
          begin
            str0:='update 系统设置  set  参数值='''+csz+'''  where 参数名称='''+csmc+'''';
            query1.Close;
            query1.SQL.Clear;
            query1.SQL.Add(str0);
            query1.ExecSQL;
          end;
      end;
  end;
procedure  gxcsz(csmc:string);
  var str0:string;
      csz:string;
  begin
    str0:='select 参数值  from 系统设置  where 参数名称='''+csmc+'''';
    with dm do
      begin
        query1.Close;
        query1.SQL.Clear;
        query1.SQL.Add(str0);
        query1.Open;
        csz:=query1.fieldbyname('参数值').asstring;
        csz:=floattostr(strtofloat(csz)+1);
      end;
    str0:='update 系统设置  set 参数值='''+csz+''' where 参数名称='''+csmc+'''';
    with dm do
      begin
        query1.Close;
        query1.SQL.Clear;
        query1.SQL.Add(str0);
        query1.ExecSQL;
      end;
  end;
function   qcsz(x:integer;csmc:string):string;
  var str0:string;
      gs0:string;
      i:integer;
  begin
    gs0:='';
    for i:=1 to x do
      begin
        gs0:=gs0+'0';
      end;
    str0:='select 参数值  from 系统设置  where 参数名称='''+csmc+'''';
    with  dm do
      begin
        query1.Close;
        query1.SQL.Clear;
        query1.SQL.Add(str0);
        query1.open;
        if query1.RecordCount<1 then
          begin
            str0:='insert into 系统设置(参数名称,参数值) values ('''+csmc+''',''1'' )';
            query1.Close;
            query1.SQL.Clear;
            query1.SQL.Add(str0);
            query1.ExecSQL;
            result:=formatfloat(gs0,1);
            exit;
          end;
        if query1.RecordCount=1 then
          begin
            result:=formatfloat(gs0,query1.fieldbyname('参数值').asfloat);
            exit;
          end;
      end;
  end;
function qmc(bm:string;bh:string;bhmc:string;dwmc:string):string;
  var str0:string;
  begin
    str0:='select '+dwmc+'  from '+bm+' where '+bhmc+'='''+bh+'''';
    with dm do
      begin
        query1.Close;
        query1.sql.Clear;
        query1.SQL.Add(str0);
        query1.Open;
        if query1.FieldByName(dwmc).AsString<>'' then
          result:=query1.FieldByName(dwmc).AsString
        else
          //result:='无';
          result:=bh;
      end;
  end;
function qbh(bm:string;mc:string;dwmc:string;bhmc:string):string;
  var str0:string;
  begin
    str0:='select '+bhmc+' from '+bm+'  where '+dwmc+'='''+mc+'''';
    with dm do
      begin
        query1.Close;
        query1.sql.Clear;
        query1.SQL.Add(str0);
        query1.Open;
        if query1.FieldByName(bhmc).AsString<>'' then
          result:=query1.FieldByName(bhmc).AsString
        else
          result:='无';
      end;
  end;
function jm(zfc:string):string;
var c1:integer;
    c2:integer;
    i:byte;
    str0:string;
    key:word;
    j:integer;
    str2: array of char;
  begin
    c1:=52485;
    c2:=22719;
    key:=12345;
    str0:=zfc;
    j:=length(str0);
    SetLength(str2,j);
    for i:=1 to length(str0) do
      begin
        str2[i-1]:=chr(byte(str0[i])xor(key shr 8));
        key:=(byte(str2[i-1])+key)*c1+c2;
        if key>12345 then
        key:=12345-i*100;
      end;
    result:=copy(string(str2),1,j);
  end;
function  qsj():tdatetime;
begin
  with dm do
    begin
      query1.Close;
      query1.SQL.Clear;
      query1.SQL.Add('select getdate() as sj');
      query1.Open;
      result:=query1.fieldbyname('sj').Asdatetime;
    end;
end;
function qny(fwqsj:tdatetime):string;
  var year1,month1,day1:word;
begin
  //decodedate(fwqsj,year1,month1,day1);
  //result:=inttostr(year1)+inttostr(month0);
end;
function convChinese(sz:string):string; //把数字变为汉字元角分
type szlx=array[0..14] of pchar;
const
   YeSSW:szlx=('零','壹','贰','叁','肆','伍','陆','柒','捌','玖','拾','佰','仟','万','亿');
   // YeSSW:szlx=('零','一','二','三','四','五','六','七','八','九','十','百','千','万','亿');
    YJF:array[0..3] of pchar=('元','角','分','整');

var
    i,j:integer;
    szlen:integer;
    ss:pchar;
    zsbf,zstb:string; //整数部分,整数头部
    tbws:integer;
    str0,destr:array of string; //整数分解
    xs,xsbf:string;  //小数部分
    temp:string;
    k,k4:integer; //四位一串
    yes,is0,jiazero:boolean;
    has0000:boolean;//有四位是空
begin
result:='';
ss:=pchar(sz);
  while  (ss^='0') or(ss^=' ') do
   begin
   sz:=copy(sz,2,length(sz)-1);
   ss:=pchar(sz);

   end;

 if pos('.',sz)>0 then
  begin
  xs:=copy(sz,pos('.',sz)+1,length(sz)-pos('.',sz));
  xs:=floattostr(round(strtofloat('0.'+xs)*100));
  if length(xs)=1 then xs:='0'+xs;
  temp:=copy(sz,1,pos('.',sz)-1);
  end
  else
  begin
  xs:='00';
  temp:=sz;
  end;
/////处理小数部分
  xsbf:='';
   for i:=0 to length(xs)-1 do
    begin
     if i=1 then
     case xs[i+1] of
     '0': xsbf:=xsbf;
     '1': xsbf:=xsbf+yessw[1]+yjf[i+1];
     '2': xsbf:=xsbf+yessw[2]+yjf[i+1];
     '3': xsbf:=xsbf+yessw[3]+yjf[i+1];
     '4': xsbf:=xsbf+yessw[4]+yjf[i+1];
     '5': xsbf:=xsbf+yessw[5]+yjf[i+1];
     '6': xsbf:=xsbf+yessw[6]+yjf[i+1];
     '7': xsbf:=xsbf+yessw[7]+yjf[i+1];
     '8': xsbf:=xsbf+yessw[8]+yjf[i+1];
     '9': xsbf:=xsbf+yessw[9]+yjf[i+1];
     end

     else
     case xs[i+1] of
     '0': xsbf:=xsbf+yessw[0];
     '1': xsbf:=xsbf+yessw[1]+yjf[i+1];
     '2': xsbf:=xsbf+yessw[2]+yjf[i+1];
     '3': xsbf:=xsbf+yessw[3]+yjf[i+1];
     '4': xsbf:=xsbf+yessw[4]+yjf[i+1];
     '5': xsbf:=xsbf+yessw[5]+yjf[i+1];
     '6': xsbf:=xsbf+yessw[6]+yjf[i+1];
     '7': xsbf:=xsbf+yessw[7]+yjf[i+1];
     '8': xsbf:=xsbf+yessw[8]+yjf[i+1];
     '9': xsbf:=xsbf+yessw[9]+yjf[i+1];
     end;
    end;
 if xs='00' then xsbf:=yjf[3];
 ////处理整数部分
 zsbf:='';
 k4:=trunc(length(temp)/4);
 if (k4*4)<length(temp) then
      begin
      setlength(destr,k4+1);
      destr[k4]:=copy(temp,1,length(temp)-k4*4);
      end
          else
          begin
           setlength(destr,k4);
          end;
    for i:=0 to k4-1  do
      begin
       destr[i]:=copy(temp,length(temp)-k4*4+i*4+1,4);
      end;

   //////确定zstb（整数头部）后什么时候加零
   //////如果zsbf(整数部分）的第一位为零而第二位不为零
   jiazero:=false;
//   if (destr[0,1]='0') and (destr[0,2]<>'0') then jiazero:=true;
   is0:=false;
   for i:=1 to k4 do
    begin
   if destr[i-1]='0000' then begin is0:=true;has0000:=true; end;
   if destr[i-1]<>'0000' then
     for j:=1 to 4 do
      begin
         if destr[i-1,j]='0' then
         is0:=true;


       if j=4 then
          case destr[i-1,j] of
         '0': zsbf:=zsbf;
         '1': if is0=true then
                begin
                zsbf:=zsbf+yessw[0]+yessw[1];
                is0:=false;
                end
                else
                begin
                zsbf:=zsbf+yessw[1];
                end;
         '2':
         if is0=true then
                begin
                zsbf:=zsbf+yessw[0]+yessw[2];
                is0:=false;
                end
                else
                begin
                zsbf:=zsbf+yessw[2];
                end;


         '3': if is0=true then
                begin
                zsbf:=zsbf+yessw[0]+yessw[3];
                is0:=false;
                end
                else
                begin
                zsbf:=zsbf+yessw[3];
                end;
         '4': if is0=true then
                begin
                zsbf:=zsbf+yessw[0]+yessw[4];
                is0:=false;
                end
                else
                begin
                zsbf:=zsbf+yessw[4];
                end;
         '5':if is0=true then
                begin
                zsbf:=zsbf+yessw[0]+yessw[5];
                is0:=false;
                end
                else
                begin
                zsbf:=zsbf+yessw[5];
                end;
         '6': if is0=true then
                begin
                zsbf:=zsbf+yessw[0]+yessw[6];
                is0:=false;
                end
                else
                begin
                zsbf:=zsbf+yessw[6];
                end;
         '7': if is0=true then
                begin
                zsbf:=zsbf+yessw[0]+yessw[7];
                is0:=false;
                end
                else
                begin
                zsbf:=zsbf+yessw[7];
                end;
         '8': if is0=true then
                begin
                zsbf:=zsbf+yessw[0]+yessw[8];