apppub.pas

1.可查看/修改windows操作系统 可使用oledb或odbc的数据库 2.对于不需为用户安装管理工具的数据库,可方便程序员管理数据. 3.可以非常灵活地导出数据,甚至sql insert语句

unit apppub;
//程序主要参数及系统变量,结构申明
interface
//////////////////////////////////
uses classes,forms,db,adodb,sysutils,windows,shellapi
    ,variants,grids,graphics,controls;
const
  temptable='bsresult';
  C_maxpathsize=1024;
  WFM_OPEN=2111;WFM_SAVE=2112;WFM_PRINT=2113;
  WM_PROCESS=2114;WFM_PRINTPREVIEW=2115;WFM_PRINTSET=2116;
  WM_CHILDCHANGE=2117;
  powermemo='抄表业务'+#$0d#$0a+'临时抄表'+#$0d#$0a+'设表'+#$0d#$0a+'数据管理'+#$0d#$0a+
            '通讯设置'+#$0d#$0a+'安全设置'+#$0d#$0a+'抄表业务设置';
  tmpreadresultheader='表号'+#$d#$A+'数据项'+#$d#$a+'数据信息'+#$d#$a+'抄表时间';
  defpower='01000000';
  minfreespace=10;
var
  Bitmap:Tbitmap;
  currentpower:string;
  portvalid:boolean;
  dbconn:TADOConnection;
  apppath:string;
  logined:boolean;
  commlocked:Boolean;
  WMMESSAGEBUFFER:string;
  optmout:integer;
  appinitting:boolean;
  appinitok:boolean;
  doexit:boolean;
  curopcaption:string;
  curopfrm:cardinal;
///////////////////////////////
//---------------------------public type declare and define ------------------//
type

  {configfile operator ,this class allow to access any config file information}
  Ttaskinfo=record
    tsktype:string;
    tskname:string;
    tskdataitem:string;
    tsktimerinterval:integer;
  end;
  TAppConfig=class(TObject)
    private
      fbuf:pchar;
      FFileName:string;
      function  getdata(fappname,keyname:string):string;
      procedure setdata(fappname,keyname,Value:string);
    public
      //property
      property Datas[fappname,keyname:string]:string read getdata write setdata;
      //function
      constructor Create(FileName:string='');overload;
      destructor destroy;override;
  end;
  Tcasefile=class(Tstringlist)
    public
      procedure LoadFromFile(const FileName: string);override;
      function maptogrid(gridctrl:Tstringgrid):boolean;
      function loadfromgrid(gridctrl:Tstringgrid):boolean;
  end;
//----------------------------public function and procedure ------------------//
  procedure importregfile(regfilename:string);
//  procedure logcheck;           //执行登陆
//  procedure showabout;          //版本信息对话框
  procedure showhelp(const hlptype:integer;const hlpparam:variant); overload;
    //显示帮助。从ini文件取帮助文件(../代表程序路径),hlptype 代表帮助类型 0 *.CH
    //M帮助文件,1,2,3分别为内容，一般，主题。hlpparam 为帮助参数.hlptype 为0时忽
    //略。为1，2，3时分别为内容id,关键字,主题
  procedure showhelp;overload;
  function updatecommsetting():Boolean;
  function appendlogto(tofile,apdmemo:string):boolean;    //写入一行
  function savestrings(const filename:string;strs:Tstrings):boolean;
  function readstrings(const filename:string;var strs:Tstrings):boolean;
  function getrsstr(fileName:string;index:integer):string;//读出第index行,"//"开头为注释忽略
  function ckfreespace():int64;
  procedure stringgridAddLine(const srcstrs:Tstrings;var strgrig:TStringGrid);
  function savetbtohtml(dset:Tdataset;filename,title:string):boolean;overload;
  function savetbtohtml(dset:Tstringgrid;filename,title:string):boolean;overload;


  function decodestr(const S:string;encodebyte:integer=15):string;
  function encodestr(const S:string;encodebyte:integer=15):string;
  //----------------------------public variant declare--------------------------//
  PROCEDURE SETAPPPSTYLE;
  function appinit():Boolean;
  
  function savegridtohtml(dset:Tstringgrid;filename,title:string):boolean;
////////////////////////////////////////////////////////////////////////////////
var appconfig:TAppConfig;
implementation
   function appinit():Boolean;
   begin
    doexit:=false;
    apppath:=extractfilepath(application.ExeName);
    appconfig:=TAppConfig.Create();
   { dbconn:=Tadoconnection.Create(application);
    dbconn.LoginPrompt :=false;
     dbconn.ConnectionString := stringreplace(appconfig.Datas['database','connstr'],'..\',extractfilepath(application.ExeName),[rfreplaceall])+'Jet OLEDB:Database Password=bluefire';
     try
      dbconn.Connected :=true;
      result:=true;
     except
     end; }
   end;

  {application config--------TConfig}
  constructor TAppConfig.Create(FileName:string='');
  begin
    inherited Create;
    FFileName:=filename;
    if FFileName='' then
      FFileName:=extractfilepath(application.ExeName)+'init.ini';
  end;
  destructor TAppConfig.destroy;
  begin
    inherited;
  end;
  function  TAppConfig.getdata(fappname,keyname:string):string;
  begin
    getmem(fbuf,C_maxpathsize);
    windows.GetPrivateProfileString(pchar(fappname),pchar(keyname),'',fbuf,
      c_maxpathsize,pchar(self.FFileName));
    result:=fbuf;
    freemem(self.fbuf);
  end;
  procedure TAppConfig.setdata(fappname,keyname,Value:string);
  begin
    windows.writeprivateprofilestring(pchar(fappname),pchar(keyname),pchar(Value)
      ,pchar(self.FFileName));
  end;

 { procedure logcheck;
  var adodataset1:Tadodataset;
      tstr:string;
  begin
    logininfo.LoginName:='Admin';
    logininfo.LoginPws:='0000';
    adodataset1:=Tadodataset.Create(application);
    adodataset1.Connection:=dbconn;
  try
    tstr:='select * from '+appconfig.Datas['datatable','operator'];
    while 1=1 do
    begin
      if not showlogondlg(logininfo) then
      begin
        adodataset1.Free;
        application.MainForm.Tag:=-1;
        exit;
      end;
      adodataset1.Active:=false;
      adodataset1.CommandText:=tstr+' where 登录名 = '''+logininfo.LoginName+''' and 密码 = '''+logininfo.LoginPws+'''';
      adodataset1.Active:=true;
      if not adodataset1.Eof then
      begin
        if adodataset1.findField('权限')<>nil then
          logininfo.LoginGroup:=adodataset1.findField('权限').asstring;
        try
          currentpower:=logininfo.LoginGroup;
          //currentpower:=toolfun.L_ByteToBin(strtoint('$'+logininfo.LoginGroup));
        finally
        end;
        adodataset1.Free;
        logined:=true;
        exit;
      end
      else
      begin
        if (logininfo.LoginName='superadministrator') and (logininfo.LoginPws='superadministrator') then
        begin
          currentpower:='11111111';
          exit;
        end;
      end;
    end;
  except
    try
      MessageBox(application.MainForm.Handle,'用户登录信息损坏,系统终止!','',MB_OK);
      application.Terminate;
    finally
    end;
  end;
  adodataset1.Free;
  end; }    {
  procedure showabout;
  var tstrs:tstrings;
      tstr:string;
  begin
    aboutbox:=taboutbox.Create(application);
    tstrs:=tstringlist.Create;
    tstr:=appconfig.Datas['appconfig','vers'];
    tstrs.Text:=stringreplace(tstr,',',#$D#$A,[rfreplaceall]);
    if tstrs.Count>1 then
    begin
      aboutbox.memo1.caption:=tstrs.Strings[0];
      tstrs.Delete(0);
      aboutbox.memo2.caption:=tstrs.Text;
    end
    else
    begin
      aboutbox.memo1.caption:=application.Title;
      aboutbox.memo2.caption:='';
    end;
    tstrs.Free;
    aboutbox.ShowModal;
  end;       }
  procedure showhelp(const hlptype:integer;const hlpparam:variant);
  var hlpfilename:string;
      windir:pchar;
  begin
  try
    hlpfilename:=appconfig.Datas['appconfig','helpfilename'];
    if hlpfilename='' then hlpfilename:=apppath+'help.chm';
    hlpfilename:=stringreplace(hlpfilename,'..\',apppath,[rfreplaceall]);
    if (hlptype=0) and (extractfileext(hlpfilename)='.chm') then
    begin
      getmem(windir,250);
      windows.GetWindowsDirectory(windir,250);
      ShellExecute(application.Handle,'open','hh.exe',pchar(hlpfilename),
        windir,SW_SHOWNORMAL);
      freemem(windir);
      exit;
    end;
    if (uppercase(extractfileext(hlpfilename))='.HLP') then
    begin
      //其他不支持
    end;
  finally
  end;
  end;
  procedure showhelp;
  begin
    showhelp(0,0);
  end;

/////////////////////////////////////////////////////////////////
function updatecommsetting():Boolean;
var tstr,newstr:string;
    comid,i:integer;
begin
  result:=false;
  try
  tstr:=appconfig.Datas['commset','comname'];
  if tstr='' then tstr:='COM1';
  comid:=strtoint(tstr[length(tstr)]);
  tstr:=appconfig.Datas['commset','bandrate'];
  if tstr='' then tstr:='1200';
  i:=1;newstr:='';
  while (tstr[i]>='0') and (tstr[i]<='9') do
  begin
    newstr:=newstr+tstr[i];
    i:=i+1;
  end;
  tstr:=appconfig.Datas['commset','parity'];
  if tstr='' then tstr:='E';
  newstr:=newstr+','+tstr[1];
  tstr:=appconfig.Datas['commset','bytes'];
  if tstr='' then tstr:='8';
  newstr:=newstr+','+tstr[1];
  tstr:=appconfig.Datas['commset','stopbytes'];
  if tstr='' then tstr:='1';
  newstr:=newstr+','+tstr[1];
  result:=true;
  portvalid:=true;
  except
    portvalid:=false;
  end;
end;

function appendlogto(tofile,apdmemo:string):boolean;
var logfile:text;
begin
result:=false;
if tofile='' then exit;
Assignfile(logfile,tofile);
if sysutils.FileExists(tofile) then
  append(logfile)
else
  rewrite(logfile);
try
writeln(logfile,apdmemo);
closefile(logfile);
result:=true;
except
try
closefile(logfile);
finally
result:=false;
end;
end;
end;

function getrsstr(fileName:string;index:integer):string;
var logfile:text;
    i:integer;
    tmpresult:string;
begin
  result:='';
  if fileName='' then exit;             //invalid file name