PDA

View Full Version : انتقال اطلاعات از پارادكس به اكسل



هاجر
شنبه 29 مرداد 1384, 16:07 عصر
با سلام خدمت تمامی دوستان عزیز
راستش من می خواستم یه سری اطلات که توی پارادکس هست رو به اکسل انتقال بدم
می خواستم ببینم کسی در این مورد کار کرده که من رو راهنمایی کنه . ممنون می شم از شما دوستان که سریعتر جواب بدین .
خدانگهدار

m-khorsandi
شنبه 29 مرداد 1384, 17:00 عصر
درود

این رو امتحان ، کمکت میکنه:

E_Alikhani
یک شنبه 30 مرداد 1384, 07:28 صبح
یک کامپوننت به نام TMS میتواند که این کار را انجام بده برای Download کردن اون میتونی از سایت www.TMSSoftware.com استفاده کنی .
راستی اگر خواست DownLoad کنی از قسمت DBgrid اش استفاده کن - Demoهای خودش را هم Download کن
web : www.mabrosoft.com
E-mail : E_D_Alikhani@Yahoo.com

هاجر
یک شنبه 30 مرداد 1384, 10:56 صبح
سلام
با تشکر از شما دوستان عزیز کامپوننتهای خوبی بودن منتها من می خواستم یه سری اطلاعاتی که توی برنامه من وجود داره رو به یه فایل از اکسل تبدیل کنم .
ممنون میشم اگه کمکم کنید

Delphi-Clinic
یک شنبه 30 مرداد 1384, 11:26 صبح
unit DS2XML;

interface

uses
Classes, DB;

procedure DatasetToXML(Dataset: TDataset; FileName: string);

implementation

uses
SysUtils;

var
SourceBuffer: PChar;

procedure WriteString(Stream: TFileStream; s: string);
begin
StrPCopy(SourceBuffer, s);
Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
end;

procedure WriteFileBegin(Stream: TFileStream; Dataset: TDataset);

function XMLFieldType(fld: TField): string;
begin
case fld.DataType of
ftString: Result := '"string" WIDTH="' + IntToStr(fld.Size) + '"';
ftSmallint: Result := '"i4"'; //??
ftInteger: Result := '"i4"';
ftWord: Result := '"i4"'; //??
ftBoolean: Result := '"boolean"';
ftAutoInc: Result := '"i4" SUBTYPE="Autoinc"';
ftFloat: Result := '"r8"';
ftCurrency: Result := '"r8" SUBTYPE="Money"';
ftBCD: Result := '"r8"'; //??
ftDate: Result := '"date"';
ftTime: Result := '"time"'; //??
ftDateTime: Result := '"datetime"';
else
end;
if fld.Required then
Result := Result + ' required="true"';
if fld.Readonly then
Result := Result + ' readonly="true"';
end;

var
i: Integer;
begin
WriteString(Stream, '<?xml version="1.0" standalone="yes"?>
<!-- Generated by SMExport -->' +>
'<DATAPACKET Version="2.0">');
WriteString(Stream, '<METADATA><FIELDS>');

{write th metadata}
with Dataset do
for i := 0 to FieldCount-1 do
begin
WriteString(Stream, '<FIELD attrname="' +
');
WriteString(Stream, '

');
WriteString(Stream, '</METADATA><ROWDATA>');
end;

procedure WriteFileEnd(Stream: TFileStream);
begin
WriteString(Stream, '</ROWDATA></DATAPACKET>');
end;

procedure WriteRowStart(Stream: TFileStream; IsAddedTitle: Boolean);
begin
if not IsAddedTitle then


WriteString(Stream, '<ROW');< p> end;

procedure WriteRowEnd(Stream: TFileStream; IsAddedTitle: Boolean);
begin
if not IsAddedTitle then
WriteString(Stream, '/>');
end;

procedure WriteData(Stream: TFileStream; fld: TField; AString: ShortString);
begin
if Assigned(fld) and (AString <> '') then
WriteString(Stream, ' ' + fld.FieldName + '="' + AString + '"');
end;

function GetFieldStr(Field: TField): string;

function GetDig(i, j: Word): string;
begin
Result := IntToStr(i);
while (Length(Result) < j) do
Result := '0' + Result;
end;

var Hour, Min, Sec, MSec: Word;
begin
case Field.DataType of
ftBoolean: Result := UpperCase(Field.AsString);
ftDate: Result := FormatDateTime('yyyymmdd', Field.AsDateTime);
ftTime: Result := FormatDateTime('hhnnss', Field.AsDateTime);
ftDateTime: begin
Result := FormatDateTime('yyyymmdd', Field.AsDateTime);
DecodeTime(Field.AsDateTime, Hour, Min, Sec, MSec);
if (Hour <> 0) or (Min <> 0) or (Sec <> 0) or (MSec <> 0) then
Result := Result + 'T' + GetDig(Hour, 2) + ':' + GetDig(Min, 2) + ':' + GetDig(Sec, 2) + GetDig(MSec, 3);
end;
else
Result := Field.AsString;
end;
end;



procedure DatasetToXML(Dataset: TDataset; FileName: string);
var
Stream: TFileStream;
bkmark: TBookmark;
i: Integer;
begin
Stream := TFileStream.Create(FileName, fmCreate);
SourceBuffer := StrAlloc(1024);
WriteFileBegin(Stream, Dataset);

with DataSet do
begin
DisableControls;
bkmark := GetBookmark;
First;

{write a title row}
WriteRowStart(Stream, True);
for i := 0 to FieldCount-1 do
WriteData(Stream, nil, Fields[i].DisplayLabel);
{write the end of row}
WriteRowEnd(Stream, True);

while (not EOF) do
begin
WriteRowStart(Stream, False);
for i := 0 to FieldCount-1 do
WriteData(Stream, Fields[i], GetFieldStr(Fields[i]));
{write the end of row}
WriteRowEnd(Stream, False);

Next;
end;

GotoBookmark(bkmark);
EnableControls;
end;

WriteFileEnd(Stream);
Stream.Free;
StrDispose(SourceBuffer);
end;

end.