zsqlscanner.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

  end;
  { Check for multi-line comment }
  Result := InnerProcCComment(CurrPos, CurrLineNo, CurrToken);
end;

{ Process sql strings }
function TZSqlScanner.InnerProcSqlString(var CurrPos, CurrLineNo: Integer;
  var CurrToken: string): Integer;
begin
  Result := InnerProcPasString(CurrPos, CurrLineNo, CurrToken);
end;

{ Process sql identifiers and constants }
function TZSqlScanner.InnerProcSqlIdent(var CurrPos, CurrLineNo: Integer;
  var CurrToken: string): Integer;
var
  I: Integer;
  Search: string;
begin
  { Look for digits and identifiers }
  Result := InnerProcIdent(CurrPos, CurrLineNo, CurrToken);
  { Look for sql keywords }
  if (Result = tokIdent) and ShowKeyword then
  begin
    Search := LowerCase(CurrToken);
    for I := 1 to MaxSqlKeyword do
      if SqlKeyword[I] = Search then
      begin
        Result := tokKeyword;
        Exit;
      end;
  end;
end;

{ TZIbSqlScanner }

{ Class constructor }
constructor TZIbSqlScanner.Create;
begin
  inherited Create;
  FDatabaseType := dtInterbase;
end;

{ TZMsSqlScanner }

{ Class constructor }
constructor TZMsSqlScanner.Create;
begin
  inherited Create;
  FDatabaseType := dtMsSql;
end;

{ Process MS SQL comments }
function TZMsSqlScanner.InnerProcSqlComment(var CurrPos,
  CurrLineNo: Integer; var CurrToken: string): Integer;
begin
  { Check for single-line comment }
  if (CurrToken[1] = '-') and (FBufferPos <= FBufferLen)
    and (FBuffer[FBufferPos] = '-') then
  begin
    Result := InnerProcLineComment(CurrPos, CurrLineNo, CurrToken);
    Exit;
  end;
  { Check for multi-line comment }
  Result := InnerProcCComment(CurrPos, CurrLineNo, CurrToken);
end;

{ TZOraSqlScanner }

{ Class constructor }
constructor TZOraSqlScanner.Create;
begin
  inherited Create;
  FDatabaseType := dtOracle;
end;

{ TZMySqlScanner }

{ Class constructor }
constructor TZMySqlScanner.Create;
begin
  inherited Create;
  FDatabaseType := dtMySql;
end;

{ Unconvert value into string value for MySql }
function TZMySqlScanner.UnwrapString(Value: string): string;
var
  N: Integer;
  Ptr1, Ptr2: PChar;
begin
  Result := '';
  if Value = '' then Exit;
  Delete(Value, 1, 1);
  Delete(Value, Length(Value), 1);

  SetLength(Result, Length(Value)+1);
  Ptr1 := PChar(Value);
  Ptr2 := PChar(Result);
  N := 0;
  while Ptr1^ <> #0 do
  begin
    if Ptr1^ <> '\' then
      Ptr2^ := Ptr1^
    else begin
      Inc(Ptr1);
      if Ptr1 = #0 then Break;
      case Ptr1^ of
        'n': Ptr2^ := #10;
        'r': Ptr2^ := #13;
        'Z': Ptr2^ := #26;
        '0': Ptr2^ := #0;
        else Ptr2^ := Ptr1^;
      end;
    end;
    Inc(N);
    Inc(Ptr1);
    Inc(Ptr2);
  end;
  SetLength(Result, N);
end;

{ Convert string value into string for MySql }
function TZMySqlScanner.WrapString(Value: string): string;
var
  I, Add, Len: Integer;
  Ptr: PChar;
begin
  Add := 0;
  Len := Length(Value);
  for I := 1 to Len do
    if Value[I] in ['''','"','\',#26,#10,#13,#0] then
      Inc(Add);
  SetLength(Result, Len + Add);
  Ptr := PChar(Result);
  for I := 1 to Len do
  begin
    if Value[I] in ['''','"','\',#26,#10,#13,#0] then
    begin
      Ptr^ := '\';
      Inc(Ptr);
      case Value[I] of
        #26: Ptr^ := 'Z';
        #10: Ptr^ := 'n';
        #13: Ptr^ := 'r';
        #0:  Ptr^ := '0';
        else Ptr^ := Value[I];
      end;
    end else
      Ptr^ := Value[I];
    Inc(Ptr);
  end;
  Result := '''' + Result + '''';
end;

{ Process MySql comment }
function TZMySqlScanner.InnerProcSqlComment(var CurrPos,
  CurrLineNo: Integer; var CurrToken: string): Integer;
begin
  Result := tokUnknown;
  { Check for -- single-line comment }
  if (CurrToken[1] = '-') and (FBufferPos <= FBufferLen)
    and (FBuffer[FBufferPos] = '-') then
  begin
    Result := InnerProcLineComment(CurrPos, CurrLineNo, CurrToken);
    Exit;
  end;
  { Check for # single-line comment }
  if CurrToken[1] = '#' then
  begin
    Result := InnerProcLineComment(CurrPos, CurrLineNo, CurrToken);
    Exit;
  end;
end;

{ Process MySql strings }
function TZMySqlScanner.InnerProcSqlString(var CurrPos,
  CurrLineNo: Integer; var CurrToken: string): Integer;
begin
  Result := InnerProcCString(CurrPos, CurrLineNo, CurrToken);
end;

{ TZPgSqlScanner }

{ Class constructor }
constructor TZPgSqlScanner.Create;
begin
  inherited Create;
  FDatabaseType := dtPostgreSql;
end;

{ Unconvert value into string value for PostgreSql }
function TZPgSqlScanner.UnwrapString(Value: string): string;
var
  N: Integer;
  Ptr1, Ptr2: PChar;
begin
  Result := '';
  if Value = '' then Exit;
  Delete(Value, 1, 1);
  Delete(Value, Length(Value), 1);

  SetLength(Result, Length(Value)+1);
  Ptr1 := PChar(Value);
  Ptr2 := PChar(Result);
  N := 0;
  while Ptr1^ <> #0 do
  begin
    if Ptr1^ <> '\' then
      Ptr2^ := Ptr1^
    else begin
      Inc(Ptr1);
      if Ptr1 = #0 then Break;
      case Ptr1^ of
        'n': Ptr2^ := #10;
        'r': Ptr2^ := #13;
        't': Ptr2^ := #9;
        '0': Ptr2^ := #0;
        else Ptr2^ := Ptr1^;
      end;
    end;
    Inc(N);
    Inc(Ptr1);
    Inc(Ptr2);
  end;
  SetLength(Result, N);
end;

{ Convert string value into string for PostgreSql }
function TZPgSqlScanner.WrapString(Value: string): string;
var
  I, Add, Len: Integer;
  Ptr: PChar;
begin
  Add := 0;
  Len := Length(Value);
  for I := 1 to Len do
    if Value[I] in ['''','"','\',#9,#10,#13,#0] then
      Inc(Add);
  SetLength(Result, Len + Add);
  Ptr := PChar(Result);
  for I := 1 to Len do
  begin
    if Value[I] in ['''','"','\',#9,#10,#13,#0] then
    begin
      Ptr^ := '\';
      Inc(Ptr);
      case Value[I] of
        #9:  Ptr^ := 't';
        #10: Ptr^ := 'n';
        #13: Ptr^ := 'r';
        #0:  Ptr^ := '0';
        else Ptr^ := Value[I];
      end;
    end else
      Ptr^ := Value[I];
    Inc(Ptr);
  end;
  Result := '''' + Result + '''';
end;

{ Process PostgreSql comment }
function TZPgSqlScanner.InnerProcSqlComment(var CurrPos,
  CurrLineNo: Integer; var CurrToken: string): Integer;
begin
  { Check for single-line comment }
  if (CurrToken[1] = '-') and (FBufferPos <= FBufferLen)
    and (FBuffer[FBufferPos] = '-') then
  begin
    Result := InnerProcLineComment(CurrPos, CurrLineNo, CurrToken);
    Exit;
  end;
  { Check for multi-line comment }
  Result := InnerProcCComment(CurrPos, CurrLineNo, CurrToken);
end;

{ Process PostgreSql strings }
function TZPgSqlScanner.InnerProcSqlString(var CurrPos,
  CurrLineNo: Integer; var CurrToken: string): Integer;
begin
  Result := InnerProcCString(CurrPos, CurrLineNo, CurrToken);
end;

end.