kbmmemcsvstreamformat.pas

kbmMemTable v5.50 (Dec. 12 2005)内存表控件

                  // Check if to accept that record for save.
                  Accept:=true;
                  if Assigned(ADataSet.OnSaveRecord) then ADataSet.OnSaveRecord(ADataset,Accept);
                  if not Accept then continue;

                  // Write current record.
                  s:='';
                  a:='';
                  for i:=0 to nf-1 do
                  begin
                       if SaveFields[i]>=0 then
                       begin
                            if Assigned(ADataSet.OnSaveField) then ADataSet.OnSaveField(ADataset,i,ADataSet.Fields[i]);

                            if (ADataSet.Fields[i].IsNull) then s1:=''
                            else if ADataSet.Fields[i].DataType in kbmStringTypes then
                                s1:=StringToCodedString(ADataSet.Fields[i].AsString)
                            else if ADataSet.Fields[i].DataType in kbmBinaryTypes then
                                s1:=StringToBase64(ADataSet.Fields[i].AsString)
{$IFDEF LEVEL6}
                            else if ADataSet.Fields[i].DataType=ftWideString then
 {$IFDEF DOTNET}
                                s1:=string(ADataSet.Fields[i].Value)
 {$ELSE}
                                s1:=UTF8Encode(ADataSet.Fields[i].Value)
 {$ENDIF}
{$ENDIF}
                            else if ADataSet.Fields[i].DataType=ftBoolean then
                            begin
                                 with TBooleanField(ADataSet.Fields[i]) do
                                      if Value then
                                         s1:=FCSVTrueString
                                      else
                                          s1:=FCSVFalseString;
                                 end
                            else
                                s1:=ADataSet.Fields[i].AsString;

                            null:=ADataSet.Fields[i].IsNull;
                            if assigned(FOnFormatSaveField) then
                               FOnFormatSaveField(self,ADataSet.Fields[i],null,s1);

                            if null then
                               s:=s+a
                            else if ((sfSaveQuoteOnlyStrings in sfQuoteOnlyStrings) and
                                     (not (ADataSet.Fields[i].DataType in kbmStringTypes+kbmBinaryTypes))) then
                               s:=s+a+s1
                            else
                               s:=s+a+QuoteString(s1,FCSVQuote);
                            a:=FCSVFieldDelimiter;
                       end
                       else if sfSavePlaceHolders in sfPlaceHolders then
                       begin
                            s:=s+a;
                            a:=FCSVFieldDelimiter;
                       end;
                  end;

                  // Add record delimiter.
                  if FCSVRecordDelimiter <> #0 then s:=s+FCSVRecordDelimiter;
                  s:=s+#13+#10;
                  l:=length(s);

                  // Write line.
{$IFDEF DOTNET}
                  WorkStream.WriteBuffer(bytesOf(s),l);
{$ELSE}
                  WorkStream.WriteBuffer(Pointer(s)^,l);
{$ENDIF}

                  // Increment savecounter.
                  ADataSet.SaveCount:=ADataSet.SaveCount+1;
             end;

          finally
             ADataSet.OverrideActiveRecordBuffer:=nil;
          end;
     end;
end;

function TkbmCustomCSVStreamFormat.GetChunk:boolean;
{$IFDEF DOTNET}
var
   ABuf:TBytes;
{$ENDIF}
begin
{$IFDEF DOTNET}
     setLength (aBuf,CSVBUFSIZE);
     try
       remaining_in_buf:=WorkStream.Read (abuf,CSVBUFSIZE);
       Marshal.Copy(aBuf,0,Buf,CSVBUFSIZE);
     finally
       SetLength (aBuf,0);
     end;
{$ELSE}
     remaining_in_buf:=WorkStream.Read(pointer(buf)^,CSVBUFSIZE);
{$ENDIF}
     bufptr:=buf;
     Result:=remaining_in_buf>0;

     // Show progress.
     inc(ProgressCnt);
     ProgressCnt:=ProgressCnt mod 100;
     if (ProgressCnt=0) then
         FDataset.Progress(trunc((WorkStream.Position / StreamSize) * 100),mtpcLoad);
end;

function TkbmCustomCSVStreamFormat.GetLine:boolean;
var
  EOL,EOF:boolean;
  ep,sp:{$IFDEF DOTNET}IntPtr{$ELSE}PChar{$ENDIF};
  TmpStr:string;
begin
     // Cut out a line.
     EOL:=false;
     EOF:=false;
     Line:='';
     sp:=bufptr;
     ep:=bufptr;
     while true do
     begin
          // Check if need another chunk.
          if remaining_in_buf=0 then
          begin
               // Add to line.
               if EOL then
{$IFDEF DOTNET}
                  SetString(TmpStr,sp,integer(ep)-integer(sp)+1)
{$ELSE}
                  SetString(TmpStr,sp,ep-sp+1)
{$ENDIF}
               else
{$IFDEF DOTNET}
                   SetString(TmpStr,sp,integer(bufPtr)-integer(sp));
{$ELSE}
                   SetString(TmpStr,sp,bufptr-sp);
{$ENDIF}
               Line:=Line+TmpStr;

               // Check if EOF.
               if not GetChunk then
               begin
                    EOF:=true;
                    break;
               end;
               sp:=bufptr;
{$IFDEF DOTNET}
               ep:=IntPtr(integer(bufptr)-1);
{$ELSE}
               ep:=bufptr-1;
{$ENDIF}
          end;

          // Check if we got EOL character, skip them and finally break.
{$IFDEF DOTNET}
          if (Marshal.ReadByte(bufptr,0)) in [0, 10, 13] then
          begin
               if not EOL then ep:=intPtr(integer(bufptr)-1);
               EOL:=true
          end
          else if EOL then
          begin
               SetString(TmpStr,sp,integer(ep)-integer(sp)+1);
               Line:=Line.ToString+TmpStr.ToString;
               break;
          end;

          // Prepare to look at next char.
          BufPtr:=IntPtr(integer(BufPtr) +1);
          dec(remaining_in_buf);
{$ELSE}
          if (bufptr^) in [#0, #10, #13] then
          begin
               if not EOL then ep:=bufptr-1;
               EOL:=true
          end
          else if EOL then
          begin
               SetString(TmpStr,sp,ep-sp+1);
               Line:=Line+TmpStr;
               break;
          end;

          // Prepare to look at next char.
          Inc(bufptr);
          dec(remaining_in_buf);
{$ENDIF}
     end;
{$IFDEF DOTNET}
     if assigned (BackPtr) then Marshal.FreeHGlobal(BackPtr);
     lptr:= Marshal.StringToHGlobalANSI(Line);
     BackPtr := lptr;
     elptr:=IntPtr(integer(lptr)+Length(Line));
{$ELSE}
     lptr:=PChar(Line);
     elptr:=PChar(Line)+Length(Line);
{$ENDIF}
     Result:=(not EOF);
end;

function TkbmCustomCSVStreamFormat.GetWord(var null:boolean):string;
type
    tfsmstate=(stStart,stQuote,stText,stDelim);
var
{$IFDEF DOTNET}
   sptr:IntPtr;
{$ELSE}
   sptr:PChar;
{$ENDIF}
   TmpStr:string;
   l:integer;
   state: tfsmstate;
begin
    Result:='';

    // Check if parsing without quote.
    if FCSVQuote=#0 then
    begin
         sptr:=lptr;
{$IFDEF DOTNET}
         while (Marshal.ReadByte (lptr)<>byte(FCSVFieldDelimiter)) and (Marshal.ReadByte (lptr) <> byte(FCSVRecordDelimiter)) and (integer(lptr)<integer(elptr)) do
               lPtr:=IntPtr(integer(lPtr)+1);

         l:=integer(lptr)-integer(sptr);
         if (integer(lptr)>=integer(elptr)) then inc(l); // Allow for missing fieldseperator/recordseperator at end of line.
         if (Marshal.ReadByte (lptr) = 0) then dec(l);

         SetString (Result,sptr,l);

         null:=(length(Result)<=0);
         if (Marshal.ReadByte (lptr)=byte(FCSVFieldDelimiter)) or (Marshal.ReadByte (lptr)= byte(FCSVRecordDelimiter)) then
            lPtr := IntPtr(integer (lPtr) + 1);
{$ELSE}
         while (lptr^ <> FCSVFieldDelimiter) and (lptr^ <> FCSVRecordDelimiter) and (lptr<elptr) do inc(lptr);
         l:=lptr-sptr;
         if (lptr>=elptr) then inc(l); // Allow for missing fieldseperator/recordseperator at end of line.
         if (lptr^ = #0) then dec(l);
         SetString(Result,sptr,l);
         null:=(length(Result)<=0);
         if (lptr^=FCSVFieldDelimiter) or (lptr^=FCSVRecordDelimiter) then inc(lptr);
{$ENDIF}
    end
    else
    begin
         sptr:=lptr;
         state:=stStart;
         null:=false;

         while state<>stDelim do
         begin
{$IFDEF DOTNET}
             if (integer(lptr)>=integer(elptr)) then
             begin
                  if state=stText then
                  begin
                       SetSTring (TmpStr,sptr,integer(lptr)-integer(sptr));
                       Result:=Result+TmpStr;
                  end;
                  exit;
             end;

             case state of
               stStart:
                 if Marshal.ReadByte(lptr,0)=byte(FCSVQuote) then
                 begin
                      state:=stQuote;
                      sptr:=IntPtr(integer(sptr)+1);
                 end
                 else if Marshal.ReadByte(lptr)=byte(FCSVFieldDelimiter) then
                 begin
                      state:=stDelim;
                      null:=true;
                 end
                 else
                     state:=stText;

               stText:
                 if marshal.ReadByte(lptr,0)=byte(FCSVFieldDelimiter) then
                 begin
                      SetString(TmpStr,sptr,integer(lptr)-integer(sptr));
                      sptr:=lptr;
                      Result:=Result+TmpStr;
                      state:=stDelim;
                 end;

               stQuote:
                 if Marshal.ReadByte(lptr,0)=byte(FCSVQuote) then
                 begin
                      // Either got endquote or got double quote.
                      SetString(TmpStr,sptr,integer(lptr)-integer(sptr));

                      Result:=Result+TmpStr;
                      lptr:=IntPtr(integer(lPtr)+1);
                      if Marshal.ReadByte(lptr)=byte(FCSVQuote) then
                         Result:=Result+FCSVQuote
                      else
                         state:=stDelim;
                      sptr:=lptr;
                      sptr:=intPtr(integer(sptr)+1);
                 end;
             end;

             lptr:=intPtr(integer(lptr)+1);
{$ELSE}
             if (lptr>=elptr) then
             begin
                  if state=stText then
                  begin
                       SetString(TmpStr,sptr,lptr-sptr);
                       Result:=Result+TmpStr;
                  end;
                  exit;
             end;

             case state of
               stStart:
                 if lptr^=FCSVQuote then
                 begin
                      state:=stQuote;
                      inc(sptr);
                 end
                 else if lptr^=FCSVFieldDelimiter then
                 begin
                      state:=stDelim;
                      null:=true;
                 end
                 else
                     state:=stText;

               stText:
                 if lptr^=FCSVFieldDelimiter then
                 begin
                      SetString(TmpStr,sptr,lptr-sptr);
                      sptr:=lptr;
                      Result:=Result+TmpStr;
                      state:=stDelim;
                 end;

               stQuote:
                 if lptr^=FCSVQuote then
                 begin
                      // Either got endquote or got double quote.
                      SetString(TmpStr,sptr,lptr-sptr);
                      Result:=Result+TmpStr;
                      inc(lptr);
                      if lptr^=FCSVQuote then
                         Result:=Result+FCSVQuote
                      else
                         state:=stDelim;
                      sptr:=lptr;
                      inc(sptr);
                 end;
             end;
             inc(lptr);
{$ENDIF}
         end;
    end;
end;

procedure TkbmCustomCSVStreamFormat.BeforeLoad(ADataset:TkbmCustomMemTable);
begin
     FDefLoaded:=false;
     inherited;

     // Allocate space for a buffer.
{$IFDEF DOTNET}
     buf := Marshal.AllocHGlobal(CSVBUFSIZE);
{$ELSE}
     GetMem(buf,CSVBUFSIZE);
{$ENDIF}
     // Still nothing in the buffer to handle.
     FDataset:=ADataset;
     remaining_in_buf:=0;
     StreamSize:=WorkStream.Size;
     ProgressCnt:=0;

     // Setup standard layout for data.
     Ods:=DateSeparator;
     Oms:=DecimalSeparator;
     Ots:=TimeSeparator;
     Oths:=ThousandSeparator;
     Ocf:=CurrencyFormat;
     Onf:=NegCurrFormat;
     Osdf:=ShortDateFormat;
     Ocs:=CurrencyString;

     // Check if to load in local format.
     if not (sfLoadLocalFormat in sfLocalFormat) then
     begin
          DateSeparator:='/';
          TimeSeparator:=':';
          ThousandSeparator:=',';
          DecimalSeparator:='.';
          ShortDateFormat:='dd/mm/yyyy';
          CurrencyString:='';
          CurrencyFormat:=0;
          NegCurrFormat:=1;
     end;
end;

procedure TkbmCustomCSVStreamFormat.AfterLoad(ADataset:TkbmCustomMemTable);
begin
     DateSeparator:=Ods;
     DecimalSeparator:=Oms;
     TimeSeparator:=Ots;
     ThousandSeparator:=Oths;
     CurrencyFormat:=Ocf;
     NegCurrFormat:=Onf;
     ShortDateFormat:=Osdf;
     CurrencyString:=Ocs;
{$IFDEF DOTNET}
     Marshal.FreeHGlobal(buf);
{$ELSE}