修改虫虫的三层数据库类中的一个单元文件untRmoDbClient.pas

虫子的三层数据库类很好用，使用中发现一个小问题，就是当数据库字段较多时，如果DBGEID中只显示其中几列的话，在修改数据后移动到下一行进，会出错，无法更新数据，检查是生成的UPDATE语句有问题，没有在DBGRID中显示的列也生成进去了，并给了个‘’空值，刚好数据库设置了字段不能为空，就报错了，根据自己实用，修改如下

{******************************************************* 万剑修改                585行 20120420

        单元名称：untRmoDbClient.pas         创建日期：2008-09-16 17:25:52         创建者   马敏钊         功能:     远程数据库客户端         当前版本： v2.0.2

更新历史 v1.0  单元实现 v1.1  解决不支持自增长字段的问题 v1.2  解决id号必须是第1个字段的问题 v1.3  为增加速度，做缓冲不用每次生成语句 ，改变自动更新时导致filter属性暂用的方式 v1.4  在sabason 兄的热心帮助下，解决了流试传输存在的问题，大大提高了传输效率 20100413 v1.5  全面修改为支持高效率的UniDAC数据库驱动套件 和ClientDataset (原来是ADO方式)支持所有主流数据库，大幅提高传输效率，且使用方法没有改变 v1.6  解决流传输存在的BUG  ，修正最后一个字段为blob字段导致语句生成错误的BUG v1.7  增加服务端sys.ini文件配置客户端登陆权限，增加批量执行SQL语句接口 v1.8  增加服务端提供自动升级功能，可以升级多个文件或者目录，可选择强制升级或者客户端可选升级 v2.0  增加asio高性能 C++ 完成端口稳定库的封装支持 v2.1  增加存储过程调用的支持（参考静水流深的修改版本，在此表示感谢） v2.0.2 2011-04-20                   统一和服务端的版本号 ，从v2.1修改为v2.0.2                   由于MAX()方式获取数据记录当数据表内存在大量记录时会很慢，而且可能导致ID冲突，                   所以特，增加快速获取自增长ID的方式，客户端可配置是否使用这种方式 *******************************************************}

unit untRmoDbClient;

interface

uses   Classes, UntsocketDxBaseClient, IdComponent, Controls, ExtCtrls, db, dbclient, midaslib;

type   TConnthread = class;   TSelectitems = class   public     Sql: string;   end;   TRmoClient = class(TAsioClient)   private     gLmemStream: TMemoryStream;     FCachSQllst, FsqlLst: TStrings; //用来记录已经打开了的数据集 以及对于的语句     FSqlPart1, FSqlPart2: string;

    Fsn: Cardinal;     FQryForID: TClientDataSet;     FIsDisConn: boolean; //是否是自己手动断开连接的     Ftimer: TTimer; //连接保活器     FisConning: Boolean; //是否连接成功     //定时检查是否需要重连 或者连接断开     procedure OnCheck(Sender: TObject);      //检查是否连接存活     procedure checkLive;

    procedure OnBeginPost(DataSet: TDataSet);     procedure OnBeforeDelete(DataSet: TDataSet);     function GetSvrmaxID(Iidname, itablename: string): integer;   public     IsSpeedGetID: Boolean; //是否使用高速方式获取自增长ID     IsInserIDfield: boolean; //是否插入语句 支持ID字段 自增长不允许插入该字段默认是false     FLastInsertID: Integer; //insert语句时返回插入记录的自增字段的值

    //连接服务端     function ConnToSvr(ISvrIP: ansistring; ISvrPort: Integer = 9988; Iacc: ansistring = '';       iPsd: ansistring = ''): boolean;     //断开连接     procedure DisConn;     //重新连接新的IP     function ReConn(ISvrIP: ansistring; IPort: Integer = -1; Iacc: ansistring = '';       iPsd: ansistring = ''): boolean;

    //将post模式变更为 更新语句到远端执行     procedure ReadySqls(IAdoquery: TClientDataSet);

    //执行一条语句     function ExeSQl(ISql: ansistring): Integer;     //打开一个过数据集     function OpenAndataSet(ISql: ansistring; IADoquery: TClientDataSet): Boolean;     //批量提交语句  立即执行所传入的语句列表     function BathExecSqls(IsqlList: TStrings): Integer;     //执行一个存储过程     //参数 执行语句  是否需要返回数据集     function ExecProc(iSQL: ansistring; IsBackData: boolean; cds: TClientDataSet =       nil): Boolean;

    //检查升级     procedure CheckUpdate;

    procedure OnCreate; override;     procedure OnDestory; override;   end;

TConnthread = class(TThread)   public     Client: TRmoClient;     procedure execute; override;   end;

var   //远程连接控制对象   Gob_RmoCtler: TRmoClient;   GCurrVer: integer = 1; //当前程序升级版本号

implementation

uses untfunctions, sysUtils, UntBaseProctol, IniFiles, ADOInt, Variants,   Windows, untASIOSvr;

function TRmoClient.BathExecSqls(IsqlList: TStrings): Integer; var   IErr: ansistring;   llen, i: Integer;   ls: TMemoryStream; begin   //批量执行SQL语句   ls := TMemoryStream.Create;   IsqlList.SaveToStream(ls);   EnCompressStream(ls);   llen := 4 + 4 + ls.Size;   SendAsioHead(llen);   WriteInteger(110);   SendZIpStream(ls, Self, true);   llen := ReadInteger();   if llen = -1 then begin     llen := ReadInteger();     IErr := ReadStr(llen); //    IsqlList.SaveToFile('D:\2.txt');     raise Exception.Create(IErr);   end   else begin     Result := llen;   end; end;

procedure TRmoClient.checkLive; begin   try     if IsConnected then begin       SendAsioHead(4);       if WriteInteger(4) <> 4 then begin         if FIsDisConn = False then           FisConning := False;       end;     end     else begin       if FIsDisConn = False then         FisConning := False;     end;

  except     if FIsDisConn = False then       FisConning := False;   end; end;

procedure TRmoClient.CheckUpdate; var   i, lstrlrn, illen: Integer;   li, lr, lm: integer;   ls, lspath, lflst: ansistring;   lspit: TStringList; begin   SendAsioHead(4);   WriteInteger(9998);   lr := ReadInteger;   if lr > 0 then begin     lspit := TStringList.Create;     lr := ReadInteger; //ver     lm := ReadInteger;     lstrlrn := Readinteger;     lspath := ReadStr(lstrlrn);     lstrlrn := Readinteger;     ls := ReadStr(lstrlrn);     li := ReadInteger;     lflst := ReadStr(li);     if lr > GCurrVer then begin       lspit.Add(IntToStr(lm));       lspit.Add(ls);       //后台下载下来       GetEveryWord(lflst, '|');       lspit.Add(IntToStr(GlGetEveryWord.Count));

      for i := 0 to GlGetEveryWord.Count - 1 do begin // Iterate         ls := GlGetEveryWord[i];         illen := Length(ls);         SendAsioHead(8 + illen);         SendHead(9997);         Writeinteger(illen);         Write(ls);         li := ReadInteger;         if li = 1 then begin           ls := StringReplace(GlGetEveryWord[i], lspath, '', []);           ls := GetCurrPath + ls;           ForceDirectories(ExtractFilePath(ls));           GetZipFile(ls);           lspit.Add(ls);         end;       end; // for       lspit.SaveToFile('up.cfg');       lspit.Free;       WinExec(pansichar('up.exe  ' + ExtractFileName(ParamStr(0))), SW_SHOW);     end;   end; end;

function TRmoClient.ConnToSvr(ISvrIP: ansistring; ISvrPort: Integer = 9988;   Iacc: ansistring = ''; iPsd: ansistring = ''): boolean; var   i: Integer;   ls: ansistring; begin   Result := True;   if (IsConnected = false) or (FHost <> ISvrIP) or (FPort <> ISvrPort) then begin     if IsConnected then       DisConn;     FHost := ISvrIP;     FPort := ISvrPort;     Facc := Iacc;     Fpsd := iPsd;     FIsDisConn := False;     try       Result := Connto(FHost, FPort);     except       Result := False;       FIsDisConn := False;     end;     if Result = True then begin //        SendHead(CTSLogin); //        WriteInteger(CClientID); //        if ReadInteger <> STCLogined then //          Result := False;       ls := format('%s|%s', [Iacc, Str_Encry(iPsd, 'rmo')]);       Writeinteger(Length(ls));       Write(ls);       if ReadInteger <> STCLogined then begin         Result := False;         DisConn;         FisConning := false;         Exit;       end;       FisConning := True;       FIsDisConn := False;       Ftimer.Enabled := True;     end;   end; end;

procedure TRmoClient.DisConn; begin   try     CloseConn; //    if IsConnected then //      DisConn;   except   end;   FIsDisConn := True; end;

{ TConnthread }

procedure TConnthread.execute; begin   try     if Client.ConnToSvr(Client.FHost, Client.FPort, Client.Facc, Client.Fpsd) then begin       Client.FisConning := True;     end;   finally     Client.Ftimer.Tag := 0;   end; end;

function StreamToVarArray(const S: TStream): Variant; var P: Pointer;   C: Integer;   L: Integer; begin   S.Position := 0;   C := S.Size;   Result := VarArrayCreate([1, C], varByte);   L := Length(Result);   if L <> 0 then     ;   P := VarArrayLock(Result);   try     S.Read(P^, C);   finally     VarArrayUnlock(Result);   end; end;

procedure VarArrayToStream(const V: Variant; S: TStream); var P: Pointer;   C: Integer; begin   if not VarIsArray(V) then     raise Exception.Create('Var is not array');   if VarType(V[1]) <> varByte then     raise Exception.Create('Var array is not blob array');   C := VarArrayHighBound(V, 1) - VarArrayLowBound(V, 1) + 1;   if not (C > 0) then     Exit;

  P := VarArrayLock(V);   try     S.Write(P^, C * SizeOf(Byte));     S.Position := 0;   finally     VarArrayUnLock(V);   end; end;

function DatasetFromStream(Idataset: TClientDataSet; Stream:   TMemoryStream): boolean; var   RS: Variant; begin   Result := false;   if Stream.Size < 1 then     Exit;   try     Idataset.Data := StreamToVarArray(Stream);     Result := true;   finally;   end;

end;

function TRmoClient.ExecProc(iSQL: ansistring; IsBackData: boolean; cds:   TClientDataSet = nil): Boolean; var   nReturn, i: Integer;   sErr: ansistring;   stmp: ansistring; begin   //在firebird中   //执行存储过程   //sql = 'Execute procedure ' + ProcName + '(' + Format(ParamsValues, args) + ')';   //执行返回数据集的存储过程   //sql = 'select * from ' + ProcName + '(' + Format(ParamsValues, args) + ')';   Result := True;   FLastInsertID := -1;   if not IsBackData then begin //执行存储过程     SendAsioHead(4 + 4 + length(iSQL));     WriteInteger(1010);     WriteInteger(Length(iSQL));     Write(iSQL);     nReturn := ReadInteger();     if nReturn = -1 then begin       nReturn := ReadInteger();       sErr := ReadStr(nReturn);       Result := False;       raise Exception.Create(Format('错误: %s', [sErr]));     end else begin       //{ TODO -owshx -c :  2010-11-10 下午 02:26:32 }       //stmp := ReadStr(ReadInteger());   //返回output参数值     end;   end else begin //有返回数据集     SendAsioHead(4 + 4 + length(iSQL));     WriteInteger(1011); //从存储过程返回数据集     WriteInteger(Length(iSQL));     Write(iSQL);     nReturn := ReadInteger();     if nReturn = -1 then begin       nReturn := ReadInteger();       sErr := ReadStr(nReturn);       raise Exception.Create(Format('执行语句<%s>时发生错误。', [sErr]));     end else begin       if glmemStream = nil then         glmemStream := TMemoryStream.Create       else         glmemStream.clear;       GetZipStream(glmemStream, self);       if Assigned(cds) then         DatasetFromStream(cds, glmemStream)       else begin         raise Exception.Create('返回的数据集没有指定载体。');         Result := False;       end;     end;   end;

end;

function TRmoClient.ExeSQl(ISql: ansistring): Integer; var   llen, i: Integer; begin   llen := Length(ISql);   SendAsioHead(8 + llen);   WriteInteger(1);   WriteInteger(llen);   Write(ISql);   llen := ReadInteger();   if llen = -1 then begin     llen := ReadInteger();     ISql := ReadStr(llen);     raise Exception.Create(ISql);   end   else begin     Result := llen;   end; end;

//------------------------------------------------------------------------------ // 数据post时自动更新服务端 2009-05-22 马敏钊 // 要求表必须有id号而且必须是第一个字段 //------------------------------------------------------------------------------

var   lglst: Tstrings;

function TRmoClient.GetSvrmaxID(Iidname, itablename: string): integer; var   llen, i: Integer;   ISql: string; begin   if IsSpeedGetID then begin     ISql := Format('%s|%s', [Iidname, itablename]);     llen := Length(ISql);     SendAsioHead(8 + llen);     WriteInteger(7);     WriteInteger(llen);     Write(ISql);     llen := ReadInteger();     Result := ReadInteger;     if llen = -1 then begin       llen := ReadInteger();       ISql := ReadStr(llen);       raise Exception.Create(ISql);     end;   end   else begin                   //如果需要ID字段 自动获取     if FQryForID = nil then       FQryForID := TClientDataSet.Create(nil); //    获取ID     OpenAndataSet(Format('select max(%s) as myid from %s', [Iidname, itablename]), FQryForID); //     Result := FQryForID.FieldByName('myid').AsInteger + 1;   end; end;

procedure TRmoClient.OnBeforeDelete(DataSet: TDataSet); var   I: Integer;   lsql: string;   Result, ltablename: string;   Lkey, lvalue: string;   Lindex: integer; begin

  //获取表名   i := FsqlLst.IndexOf(IntToStr(integer(DataSet)));   if i > -1 then     lsql := LowerCase(TSelectitems(FsqlLst.Objects[i]).Sql); //  LowerCase(DataSet.Filter);   if Pos('select', lsql) > 0 then begin     if lglst = nil then       lglst := TStringList.Create;     GetEveryWord(lsql, lglst, ' ');     for i := 0 to lglst.Count - 1 do       if lglst.Strings[i] = 'from' then begin         Lindex := i;         Break;       end;     if Lindex < 2 then       ExceptTip('SQL语句错误！');     ltablename := '';     for i := Lindex + 1 to lglst.Count - 1 do       if lglst.Strings[i] <> '' then begin         ltablename := lglst.Strings[i];         Break;       end;     if ltablename = '' then       ExceptTip('SQL语句错误！');   end   else     ExceptTip('无法自动提交，请先执行select');   //获取方法   with DataSet.Fields do begin     Result := 'delete from ' + ltablename + Format(' where %s=%d', [Fields[0].FieldName, Fields[0].AsInteger]);     ExeSQl(Result);   end; end;

procedure TRmoClient.OnBeginPost(DataSet: TDataSet); var   I, n: Integer;   lsql, lBobName: string;   Result, FtableName: string;   Lkey, lvalue: string;   Lindex: integer;   LblobStream: TStream; begin   //获取表名   i := FsqlLst.IndexOf(IntToStr(integer(DataSet)));   if i > -1 then     lsql := LowerCase(TSelectitems(FsqlLst.Objects[i]).Sql); //  LowerCase(DataSet.Filter);   if Pos('select', lsql) > 0 then begin     if lglst = nil then       lglst := TStringList.Create;     GetEveryWord(lsql, lglst, ' ');     for i := 0 to lglst.Count - 1 do       if lglst.Strings[i] = 'from' then begin         Lindex := i;         Break;       end;     if Lindex < 2 then       ExceptTip('SQL语句错误！');     FtableName := '';     for i := Lindex + 1 to lglst.Count - 1 do       if lglst.Strings[i] <> '' then begin         FtableName := lglst.Strings[i];         Break;       end;     if FtableName = '' then       ExceptTip('SQL语句错误！');   end   else     ExceptTip('无法自动提交，请先执行select');

  //获取方法   case TClientDataSet(DataSet).State of //     dsinsert: begin         with DataSet.Fields do begin         //如果第一个字段为只读，说明是自增长ID字段 改掉它           if Fields[0].ReadOnly = true then begin            // IsInserIDfield := True;  // 要你插入自增长字段干机八             Fields[0].ReadOnly := False;           end;           if DataSet.State = dsInsert then begin //------------------------------------------------------------------------------ // 更换为通过服务端获取ID  2011-4-20 10:46:02   马敏钊 //------------------------------------------------------------------------------             DataSet.Fields[0].AsInteger := GetSvrmaxID(DataSet.Fields[0].FieldName, FtableName);           end;          //IsInserIDfield:=True;//万剑修改 2012 04 20 //是否插入语句 支持ID字段 自增长不允许插入该字段默认是false           if IsInserIDfield then begin             n := 0;  //           end           else             n := 1;           FSqlPart1 := 'insert into ' + FtableName + '(';           FSqlPart2 := '';           for i := n to count - 1 do begin             if (fields[i].IsNull) or (trim(fields[i].AsString) = '') then               continue;   //终止循环             //如果有blob字段则跳过             if Fields[i].DataType in [ftBlob] then begin               LblobStream := TMemoryStream.Create;               TBlobField(Fields[i]).SaveToStream(LblobStream);               EnCompressStream(TMemoryStream(LblobStream));               lBobName := Fields[i].FieldName; //------------------------------------------------------------------------------ // 如果是最后一个字段则跳过之前去掉上次生成的，号  2010-04-21 马敏钊 //------------------------------------------------------------------------------               if i = count - 1 then begin                 if FSqlPart1[length(FSqlPart1) - 1] = ',' then begin                   FSqlPart1 := copy(FSqlPart1, 1, length(FSqlPart1) - 1);                   FSqlPart2 := copy(FSqlPart2, 1, length(FSqlPart2) - 1);                 end;               end;               Continue;             end;

            FSqlPart1 := FSqlPart1 + ifthen(i = n, '', ',') + Fields[i].FieldName;             case Fields[i].DataType of               ftCurrency, ftBCD, ftWord, ftFloat, ftBytes: FSqlPart2 := FSqlPart2 + ifthen(i = n, '', ',') + ifthen(Fields[i].AsString = '', '0', Fields[i].AsString);               ftBoolean, ftSmallint, ftInteger: FSqlPart2 := FSqlPart2 + ifthen(i = n, '', ',') + IntToStr(Fields[i].AsInteger);               ftDate, ftDateTime: if Fields[i].AsString = '' then FSqlPart2 := FSqlPart2 + ifthen(i = n, '', ',') + 'null' else                   FSqlPart2 := FSqlPart2 + ifthen(i = n, '', ',') + '''' + Fields[i].AsString + '''' // Modified by qnaqbgss 2010/9/11 17:56:49               else FSqlPart2 := FSqlPart2 + ifthen(i = n, '', ',') + '''' + Fields[i].AsString + '''';             end;           end;           Result := FSqlPart1 + ') values (' + FSqlPart2 + ')';         end;       end;     dsEdit: begin         with DataSet.Fields do begin           Result := 'Update ' + FtableName + ' Set ';           for I := 0 to count - 1 do begin // Iterate             if I = 0 then begin               Lkey := Fields[i].FieldName;               lvalue := Fields[i].AsString;               Continue;             end;             if (fields[i].IsNull) or (trim(fields[i].AsString) = '') then              begin               if i = count - 1 then begin     // 这里是我加进去的 万剑 20120420                 Result := copy(Result, 1, length(Result) - 1);               end;               continue;              end; 

             //如果有blob字段则跳过             if Fields[i].DataType in [ftBlob] then begin               LblobStream := TMemoryStream.Create;               TBlobField(Fields[i]).SaveToStream(LblobStream);               EnCompressStream(TMemoryStream(LblobStream));               lBobName := Fields[i].FieldName; //------------------------------------------------------------------------------ // 如果是最后一个字段则跳过之前去掉上次生成的，号  2010-04-21 马敏钊 //------------------------------------------------------------------------------               if i = count - 1 then begin                 Result := copy(Result, 1, length(Result) - 1);               end;               Continue;             end;

            Result := Result + Fields[i].FieldName + '=';             case Fields[i].DataType of //               ftCurrency, ftBCD, ftWord: Result := Result + Fields[i].AsString;               ftFloat: Result := Result + Fields[i].AsString;               ftBytes, ftSmallint, ftInteger: Result := Result + IntToStr(Fields[i].AsInteger);               ftBoolean:Result := Result +Booltostr(fields[i].AsBoolean,true);               ftDate, ftDateTime: if Fields[i].AsString = '' then result := Result + 'null' else                   result := Result + '''' + Fields[i].AsString + '''' // Modified by qnaqbgss 2010/9/11 17:57:14               else                 Result := Result + '''' + Fields[i].AsString + '''';             end; // case             if i <> Count - 1 then               Result := Result + ',';           end; // for           Result := Result + Format(' where %s=%s', [Lkey, lvalue]);         end; // with       end;   end; // case   ExeSQl(Result);   //如果有blob字段则 追加写入   if LblobStream <> nil then begin     lsql := format('update %s set %s=:%s where %s=%d', [FtableName, lBobName, 'Pbob'       , DataSet.Fields[0].FieldName, DataSet.Fields[0].AsInteger]);     SendAsioHead(8 + length(lsql) + 4 + LblobStream.Size);     WriteInteger(6);     WriteInteger(length(lsql));     Write(lsql);     WriteStream(LblobStream);   end; end;

procedure TRmoClient.OnCheck(Sender: TObject); begin   if TTimer(sender).tag = 0 then begin     if ((IsConnected = false) or (FisConning = false)) and (FIsDisConn = false) then begin       TTimer(sender).tag := 1;       with TConnthread.Create(True) do begin         FreeOnTerminate := True;         Client := Self;         Resume;       end;     end     else begin       checkLive;     end;   end; end;

procedure TRmoClient.OnCreate; begin   inherited;   IsSpeedGetID := True;   FCachSQllst := THashedStringList.Create;   Ftimer := TTimer.Create(nil);   Ftimer.OnTimer := OnCheck;   Ftimer.Interval := 3000;   Ftimer.Enabled := False;   Ftimer.Tag := 0;   FisConning := false;   FIsDisConn := False;   FsqlLst := THashedStringList.Create;   gLmemStream := TMemoryStream.Create; end;

procedure TRmoClient.OnDestory; begin   inherited;   FCachSQllst.Free;   if FQryForID <> nil then     FQryForID.Free;   Ftimer.Free;   FsqlLst.Free;   gLmemStream.Free; end;

function TRmoClient.OpenAndataSet(ISql: ansistring;   IADoquery: TClientDataSet): Boolean; var   llen, i: Integer;   ls: ansistring;   Lend: integer;   Litem: TSelectitems; begin   inc(Fsn);   Lend := 0;   ls := ISql;   llen := length(isql);   SendAsioHead(8 + llen);   WriteInteger(2);   WriteInteger(llen);   Write(ISql);   llen := ReadInteger();   if llen = -1 then begin     llen := ReadInteger();     ISql := ReadStr(llen);     raise Exception.Create(ISql);   end   else begin     //记录着 是否可以自动保存     i := FsqlLst.IndexOf(IntToStr(integer(IADoquery)));     if i = -1 then begin       Litem := TSelectitems.Create;       FsqlLst.AddObject(IntToStr(integer(IADoquery)), Litem);     end     else       Litem := TSelectitems(FsqlLst.Objects[i]);     Litem.Sql := ISql;      //记录一下     ReadySqls(IADoquery);     if llen = 1 then begin       if gLmemStream = nil then         gLmemStream := TMemoryStream.Create;       GetZipStream(gLmemStream, self);       DatasetFromStream(IADoquery, gLmemStream);     end     else begin       ISql := GetCurrPath + GetDocDate + GetDocTime + IntToStr(Fsn);       GetZipFile(ISql);       IADoquery.LoadFromFile(ISql);       DeleteFile(pchar(ISql));     end;     Result := True;   end; end;

procedure TRmoClient.ReadySqls(IAdoquery: TClientDataSet); begin   IAdoquery.BeforePost := OnBeginPost;   IAdoquery.BeforeDelete := OnBeforeDelete; end;

function TRmoClient.ReConn(ISvrIP: ansistring; IPort: Integer = -1; Iacc: ansistring = '';   iPsd: ansistring = ''): boolean; begin   Result := False;   if IsLegalIP(ISvrIP) then begin     Result := ConnToSvr(ISvrIP, IfThen(IPort = -1, FPort, IPort), iacc, ipsd);   end; end;

end.

转载于:https://www.cnblogs.com/wanjian/archive/2012/12/25/2833241.html