kbmmemcsvstreamformat.pas

内存表控件 kbmMemTable

	        for I:=1 to Pred(Len) do
          begin
	             if Bits<6 then
               begin
	                  Act:=(Act shr 6) or (Ord(Source[P]) shl Bits);
		                Inc(P);
		                Inc(Bits,2);
               end
               else
               begin
	                  Dec(Bits,6);
		                Act:=Act shr 6;
               end;
	             Result[I]:=Char(Act and 63+32);
          end;
	        Result[Len]:=Char(Act shr 6+32);
     end
     else
        Result:='';
end;

// Decode BASE64 string.
function Base64ToString(const Source:string): string;
var
   Act: Word;
   Bits,I,P,Len: Integer;
begin
     Len:=(Length(Source)*3) div 4;
     SetLength(Result,Len);
     Bits:=0;
     Act:=0;
     P:=1;
     for I:=1 to system.Length(Source) do
     begin
          Act:=Act or (Ord(Source[I])-32) shl Bits;
	        if Bits>=2 then
          begin
	             Result[P]:=Char(Act and $FF);
	             Inc(P);
	             Act:=Act shr 8;
	             Dec(Bits,2);
          end
          else
	            Inc(Bits,6);
     end;
end;

// Quote a string.
function QuoteString(const Source:string; Quote:char):string;
begin
     if Quote=#0 then Result:=Source
     else Result:=AnsiQuotedStr(Source,Quote);
end;

// Extract a quoted string.
function ExtractQuoteString(const Source:string; Quote:char):string;
var
   p:PChar;
begin
     p:=PChar(Source);
     if Quote=#0 then Result:=Source
     else Result:=AnsiExtractQuotedStr(p,Quote);
end;

// TKbmCustomCSVStreamFormat
//*******************************************************************

constructor TkbmCustomCSVStreamFormat.Create(AOwner:TComponent);
begin
     inherited;
     FCSVQuote:='"';
     FCSVFieldDelimiter:=',';
     FCSVRecordDelimiter:=',';
     FCSVTrueString:='True';
     FCSVFalseString:='False';
     FsfLocalFormat:=[];
     FsfPlaceHolders:=[];
end;

function TkbmCustomCSVStreamFormat.GetVersion:string;
begin
     Result:='3.00';
end;

procedure TkbmCUstomCSVStreamFormat.Assign(Source:TPersistent);
begin
     if Source is TkbmCustomCSVStreamFormat then
     begin
          CSVQuote:=TkbmCustomCSVStreamFormat(Source).CSVQuote;
          CSVFieldDelimiter:=TkbmCustomCSVStreamFormat(Source).CSVFieldDelimiter;
          CSVRecordDelimiter:=TkbmCustomCSVStreamFormat(Source).CSVRecordDelimiter;
          CSVTrueString:=TkbmCustomCSVStreamFormat(Source).CSVTrueString;
          CSVFalseString:=TkbmCustomCSVStreamFormat(Source).CSVFalseString;
          sfLocalFormat:=TkbmCustomCSVStreamFormat(Source).sfLocalFormat;
          sfPlaceHolders:=TkbmCustomCSVStreamFormat(Source).sfPlaceHolders;
     end;
     inherited;
end;

procedure TkbmCustomCSVStreamFormat.SetCSVFieldDelimiter(Value:char);
begin
     if Value<>#0 then FCSVFieldDelimiter:=Value;
end;

procedure TkbmCustomCSVStreamFormat.BeforeSave(ADataset:TkbmCustomMemTable);
begin
     // Check if trying to save deltas in CSV format. Not supported.
     if sfSaveDeltas in sfDeltas then
        raise EMemTableError.Create(kbmSavingDeltasBinary);

     inherited;

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

     if not (sfSaveLocalFormat in FsfLocalFormat) then
     begin
          DateSeparator:='/';
          TimeSeparator:=':';
          ThousandSeparator:=',';
          DecimalSeparator:='.';
          ShortDateFormat:='dd/mm/yyyy';
          CurrencyString:='';
          CurrencyFormat:=0;
          NegCurrFormat:=1;
     end;
end;

procedure TkbmCustomCSVStreamFormat.AfterSave(ADataset:TkbmCustomMemTable);
begin
     // Restore locale setup.
     DateSeparator:=Ods;
     DecimalSeparator:=Oms;
     TimeSeparator:=Ots;
     ThousandSeparator:=Oths;
     CurrencyFormat:=Ocf;
     NegCurrFormat:=Onf;
     ShortDateFormat:=Osdf;
     CurrencyString:=Ocs;

     inherited;
end;

procedure TkbmCustomCSVStreamFormat.SaveDef(ADataset:TkbmCustomMemTable);
var
   i,l:integer;
   nf:integer;
   s:string;
begin
     if not (sfSaveDef in sfDef) then exit;

     with TkbmProtCustomMemTable(ADataSet) do
     begin
          // Setup flags for fields to save.
          nf:=Fieldcount;

{$IFNDEF CSV_FILE_1XX_COMPATIBILITY}
          // Write file version.
          s:=QuoteString(PChar(kbmFileVersionMagic),FCSVQuote)+FCSVFieldDelimiter+QuoteString(IntToStr(kbmCSVFileVersion),FCSVQuote)+#13+#10;
          l:=length(s);
          WorkStream.WriteBuffer(Pointer(s)^, l);
{$ENDIF}

          // Write header.
          s:=QuoteString(PChar(kbmTableDefMagicStart),FCSVQuote)+#13+#10;
          l:=length(s);
          WorkStream.WriteBuffer(Pointer(s)^, l);

          // Write fielddefinitions.
          for i:=0 to nf-1 do
          begin
               if (SaveFields[i]>=0) or (sfSavePlaceHolders in sfPlaceHolders) then
               begin
                    s:=Fields[i].FieldName+'='+
                        FieldTypeNames[Fields[i].DataType]+','+
                        inttostr(Fields[i].Size)+','+
                        QuoteString(Fields[i].DisplayName,'"')+','+
                        QuoteString(Fields[i].EditMask,'"')+','+
                        inttostr(Fields[i].DisplayWidth);
                    if Fields[i].Required then s:=s+',REQ';
                    if Fields[i].ReadOnly then s:=s+',RO';
                    if sfSaveFieldKind in sfFieldKind then
                       s:=s+','+FieldKindNames[ord(Fields[i].FieldKind)]
                    else
                        s:=s+','+FieldKindNames[0];
{$IFDEF LEVEL4}
                    s:=s+','+QuoteString(Fields[i].DefaultExpression,'"');
{$ENDIF}
                    s:=QuoteString(PChar(s),FCSVQuote)+#13+#10;
                    l:=length(s);
                    WorkStream.WriteBuffer(Pointer(s)^, l);
               end;
          end;

{$IFNDEF CSV_FILE_1XX_COMPATIBILITY}
          // Check if to write index definitions.
          if sfSaveIndexDef in sfIndexDef then
          begin
               // Write header.
               s:=QuoteString(PChar(kbmIndexDefMagicStart),FCSVQuote)+#13+#10;
               l:=length(s);
               WorkStream.WriteBuffer(Pointer(s)^, l);

               // Write indexdefinitions.
               for i:=0 to IndexDefs.count-1 do
                   with IndexDefs.Items[i] do
                   begin
                        s:=Name+'='+
                           QuoteString(Fields,FCSVQuote)+','+
{$IFDEF LEVEL3}
                           Name;
{$ELSE}
                           QuoteString(DisplayName,FCSVQuote);
{$ENDIF}
                        if ixDescending in Options then s:=s+',DESC';
                        if ixCaseInsensitive in Options then s:=s+',CASE';
{$IFNDEF LEVEL3}
                        if ixNonMaintained in Options then s:=s+',NONMT';
{$ENDIF}
                        if ixUnique in Options then s:=s+',UNIQ';
                        s:=QuoteString(PChar(s),FCSVQuote)+#13+#10;
                        l:=length(s);
                        WorkStream.WriteBuffer(Pointer(s)^, l);
                   end;

               // Write footer.
               s:=QuoteString(PChar(kbmIndexDefMagicEnd),FCSVQuote)+#13+#10;
               l:=length(s);
               WorkStream.WriteBuffer(Pointer(s)^, l);
          end;
{$ENDIF}

          // Write footer.
          s:=QuoteString(PChar(kbmTableDefMagicEnd),FCSVQuote)+#13+#10;
          l:=length(s);
          WorkStream.WriteBuffer(Pointer(s)^, l);
     end;
end;

procedure TkbmCustomCSVStreamFormat.SaveData(ADataset:TkbmCustomMemTable);
var
   i,j,l:integer;
   nf:integer;
   s,s1,a:string;
   Accept:boolean;
   null:boolean;
begin
     with TkbmProtCustomMemTable(ADataSet) do
     begin
          FSaveCount:=0;

          // Setup flags for fields to save.
          nf:=Fieldcount;

          // Save header.
          if not (sfSaveNoHeader in sfNoHeader) then
          begin
               // Write all field display names in CSV format.
               s:='';
               a:='';
               for i:=0 to nf-1 do
               begin
                    if (SaveFields[i]>=0) or (sfSavePlaceHolders in sfPlaceHolders) then
                    begin
                         s:=s+a+QuoteString(PChar(Fields[i].DisplayName),FCSVQuote);
                         a:=FCSVFieldDelimiter;
                    end;
               end;
               if FCSVRecordDelimiter <> #0 then s:=s+FCSVRecordDelimiter;
               s:=s+#13+#10;
               l:=length(s);
               WorkStream.Write(Pointer(s)^, l);
          end;

          // Write all records in CSV format ordered by current index.
          if sfSaveData in sfData then
          begin
               try
                  FSavedCompletely:=true;
                  for j:=0 to CurIndex.References.Count-1 do
                  begin
                       // Check if to save more.
                       if (FSaveLimit>0) and (FSaveCount>=FSaveLimit) then
                       begin
                            FSavedCompletely:=false;
                            break;
                       end;

                       // Check if to invoke progress event if any.
                       if (j mod 100)=0 then Progress(trunc((j/CurIndex.References.count)*100),mtpcSave);

                       // Setup which record to work on.
                       OverrideActiveRecordBuffer:=PkbmRecord(CurIndex.References.Items[j]);
                       if OverrideActiveRecordBuffer=nil then continue;

                       // Calculate fields.
                       ClearCalcFields(PChar(OverrideActiveRecordBuffer));
                       GetCalcFields(PChar(OverrideActiveRecordBuffer));

                       // Check filter of record.
                       Accept:=FilterRecord(OverrideActiveRecordBuffer,false);
                       if not Accept then continue;

                       // Check if to accept that record for save.
                       Accept:=true;
                       if Assigned(OnSaveRecord) then 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(OnSaveField) then OnSaveField(ADataset,i,Fields[i]);

                                 if (Fields[i].IsNull) then s1:=''
                                 else if Fields[i].DataType in kbmStringTypes then
                                     s1:=StringToCodedString(Fields[i].AsString)
                                 else if Fields[i].DataType in kbmBinaryTypes then
                                     s1:=StringToBase64(Fields[i].AsString)
                                 else if Fields[i].DataType=ftBoolean then
                                 begin
                                      with TBooleanField(Fields[i]) do
                                           if Value then
                                              s1:=FCSVTrueString
                                           else
                                               s1:=FCSVFalseString;
                                      end
                                 else
                                     s1:=Fields[i].AsString;

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

                                 if null then
                                    s:=s+a
                                 else if ((sfSaveQuoteOnlyStrings in sfQuoteOnlyStrings) and
                                          (not (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;