// TRowDataList:
//  存放Recordset的數據.
unit RowData;

interface
uses Classes, SysUtils, ADOInt, Variants;

type
  PRowData = ^TRowData;
  TRowData = array[0..0] of string;

  TRowDataList = class
  private
    FData: TList;
    FFieldCount: Integer;
    FFieldNames: array of string;

    procedure Clear;
    procedure FreeRowData(P: PRowData);
    function AllocRowData: PRowData;
    function GetFieldName(Index: Integer): string;
    function ImportByBinding(Rst: _Recordset; var Canceled: Boolean): Boolean;
    function ImportByNormal(Rst: _Recordset; var Canceled: Boolean): Boolean;
  public
    constructor Create;
    destructor Destroy; override;

    // 字段個數
    property FieldCount: Integer read FFieldCount;
    // 字段名稱
    property FieldName[Index: Integer]: string read GetFieldName;
    // 數據.
    property Data: TList read FData;
    // 導出數據.
    // Rst: ADO Recordset對象
    // Canceled: 取消標志. 傳入時為FALSE, 函數在導入每一行數據后, 檢測此變量,
    // 如果Canceled為TRUE, 則取消導入. (可以在另一線程更改此變量).
    // 返回: TRUE 成功導入; FALSE 導入時Canceled變量設為TURE
    function ImportRecordset(Rst: _Recordset; var Canceled: Boolean): Boolean;
  end;

implementation

uses ADOBinding, Pub;

{ TRowDataList }

function TRowDataList.AllocRowData: PRowData;
begin
  Result := AllocMem(FFieldCount * SizeOf(Pointer));
end;

procedure TRowDataList.Clear;
var
  I: Integer;
  P: PRowData;
begin
  for I := 0 to FData.Count-1 do
  begin
    P := FData[I];
    FreeRowData(P);
    FreeMem(P);
  end;
end;

constructor TRowDataList.Create;
begin
  FData := TList.Create;
end;

destructor TRowDataList.Destroy;
begin
  Clear;
  FData.Free;
  inherited;
end;

procedure TRowDataList.FreeRowData(P: PRowData);
var
  I: Integer;
begin
  for I := 0 to FFieldCount - 1 do
    P[I] := '';
end;

function TRowDataList.GetFieldName(Index: Integer): string;
begin
  if (Index < 0) or (Index >= FFieldCount) then
    raise Exception.Create('Index out of bound.');

  Result := FFieldNames[Index];
end;

function TRowDataList.ImportByBinding(Rst: _Recordset;
  var Canceled: Boolean): Boolean;
var
  Binding: TADOBinding;
  I: Integer;
  Fld: Field;
  FieldData: PColumnRawData;
  P: PRowData;
  s: string;
  FldTypes: array of Integer;

M,N: Integer;

  function IsCanceled: Boolean;
  begin
    Result := Canceled;
  end;
begin
  Result := True;
  Binding := TADOBinding.Create;
  try
    SetLength(FldTypes, FFieldCount);
    // set bindings
    for I := 0 to FFieldCount - 1 do
    begin
      Fld := Rst.Fields[I];
      FldTypes[I] := Fld.Type_;
      // 一律轉化為string, 讓OLE DB內部去搞吧.
      case Fld.Type_ of
        adLongVarChar,
        adLongVarWChar,
        adLongVarBinary,
        adBinary,
        adVarBinary,
        adBSTR,
        adChar,
        adVarChar,
        adWChar,
        adVarWChar:
          Binding.AddBinding(I + 1, adVarChar, 256 + 1, False);

//        adBSTR,
//        adChar,
//        adVarChar:
//          Binding.AddBinding(I + 1, adVarChar, Fld.DefinedSize + 1, False);
//
//        adWChar,
//        adVarWChar:
//          Binding.AddBinding(I + 1, adVarChar, Fld.DefinedSize + 1, False);

      else
        Binding.AddBinding(I + 1, adVarChar, 50 + 1, False);
      end;
    end;

    (Rst as IADORecordBinding).BindToRecordset(Binding.GetADOBindingData);

    M := 0;
    while not Rst.EOF do
    begin
      P := AllocRowData;
      N := 0;
      for I := 0 to FFieldCount - 1 do
      begin
        FieldData := Binding.AsRawData[I];
        if not (FieldData.Status in
              [adFldOK, adFldNull, adFldTruncated, adFldDefault]) then
        begin
          // 假如出錯, 應該是OLE DB不能處理的一些數據轉換.
          raise Exception.Create('ADO.ISqlW: get field data error.');
        end;

        if FieldData.Status = adFldNull then
          P[I] := 'NULL'
        else
        begin
          try

          case FldTypes[I] of
            adLongVarChar,
            adLongVarWChar,
            adLongVarBinary,
            adBinary,
            adVarBinary,
            adBSTR,
            adChar,
            adVarChar,
            adWChar,
            adVarWChar:
              if FieldData.DataLength > 256 then
                FieldData.DataLength := 256;
          else
            if FieldData.DataLength > 50 then
              FieldData.DataLength := 50;
          end;

          SetString(s, PChar(@FieldData.RawData), FieldData.DataLength);
          if (FldTypes[I] = adLongVarBinary) or
            (FldTypes[I] = adVarBinary) or (FldTypes[I] = adBinary)
          then s := '0x' + s;

          P[I] := s;

          except  // 好像還有問題, 姑且留著
            s := Format('Row:%d, Field:%d, Len: %d, Stat: %d', [M, N, FieldData.DataLength, FieldData.Status]);
            raise Exception.Create(s); 
          end;
        end;
        Inc(N);
      end;

      FData.Add(P);

      if IsCanceled then
      begin
        Result := False;
        Exit;
      end;

      Rst.MoveNext;
      Inc(M);
    end;
  finally
    (Rst as IADORecordBinding).BindToRecordset(nil);
    Binding.Free;
  end;
end;

function TRowDataList.ImportByNormal(Rst: _Recordset;
  var Canceled: Boolean): Boolean;
var
  I: Integer;
  P: PRowData;
  V: OleVariant;

  function IsCanceled: Boolean;
  begin
    Result := Canceled;
  end;
begin
  Result := True;
  while not Rst.EOF do
  begin
    P := AllocRowData;
    for I := 0 to FFieldCount - 1 do
    begin
      V := Rst.Fields[I].Value;
      if VarIsNull(V) then
        P[I] := 'NULL'
      else if VarIsArray(V) then
        P[I] := '(Blob)'
      else
        P[I] := String(V);
    end;

    FData.Add(P);

    if IsCanceled then
    begin
      Result := False;
      Exit;
    end;

    Rst.MoveNext;
  end;
end;

function TRowDataList.ImportRecordset(Rst: _Recordset; var Canceled: Boolean): Boolean;
var
  I: Integer;
  Ver: Double;

  function IsCanceled: Boolean;
  begin
    Result := Canceled;
  end;

begin
  Result := True;

  // 清除舊的數據.
  Clear;

  if (Rst <> nil) and ((Rst.State and adStateOpen) = adStateOpen) then
  begin
    // 創建新的
    FFieldCount := Rst.Fields.Count;
    SetLength(FFieldNames, FFieldCount);
    for I := 0 to Rst.Fields.Count-1 do
      FFieldNames[I] := Rst.Fields[I].Name;

    if Rst.Supports(adMovePrevious) then Rst.MoveFirst;

    Ver := StrToFloat(Pub.ADOVer);
    if Ver >= 2.0 then // 用ADO Binding效率會高一些.
      Result := ImportByBinding(Rst, Canceled)
    else
      Result := ImportByNormal(Rst, Canceled);
  end;
end;

end.