I've got an sql database from a customer. In the sql database is a table, called "documents". The documents are stored as blobs (have a look at the screenshot).
I want to restore the documents via Delphi (FileStream?). Do you have any ideas how to do that?
Regards,
Dennis Friedrich
function SaveFieldBlobToFile(FQuery: TDataSet): boolean;
var MyStream : TMemoryStream;
begin
Result:= false;
MyStream:= TMemoryStream.Create;
try
(FQuery.Fieldbyname('MODELE') as TBlobField).SaveToStream(MyStream);
if (MyStream<>nil) and (MyStream.Size > 0) then
begin
MyStream.Position := 0;
MyStream.SaveToFile('C:\Temp\tempMyFile.zip');
Result:= true;
end
else Result:= false;
finally
MyStream.Free;
end;
end;
function LoadFileToBlob(FQuery: TDataSet): boolean;
var MyStream : TMemoryStream;
begin
Result:= false;
MyStream := TMemoryStream.Create;
try
MyStream.LoadFromFile('C:\Temp\tempMyFile.zip');
MyStream.Position := 0;
TryEdit(FQuery);
(FQuery.FieldByName('MODELE') As TBlobField).LoadFromStream(MyStream);
TryPost(FQuery);
Result := True;
finally
MyStream.Free;
end;
end;
Related
Am trying to store my TTreeView inside SQL Server database table by using the next procedure:
procedure Save;
var
BlobField :TBlobField;
Query:TADOQuery;
Stream:TStream;
begin
Stream := TMemoryStream.Create;
Query := TADOQuery.Create(Self);
Query.SQL.Add('Select * From MyTable') ;
Query.Active := True;
Query.First;
Query.Edit;
BlobField := Query.FieldByName('MyTableField') as TBlobField;
Stream := Query.CreateBlobStream(BlobField, bmWrite);
TreeView1.SaveToStream(Stream);
Query.Refresh;
Query.Free;
Stream.Free;
end;
But every time I am getting the error: DataSet is not in edit or insert mode.
I'm using Delphi 10.1, Win 10, SQL server 2019.
Change Query.Refresh; to Query.Post;
Also, you need to Free the blob stream to finalize writing to the blob field before you then Post to commit the new data into the DB.
Also, you are leaking an unused TMemoryStream object.
Try this:
procedure Save;
var
BlobField: TField;
Query: TADOQuery;
Stream: TStream;
begin
Query := TADOQuery.Create(nil);
try
Query.SQL.Text := 'Select TOP(1) * From MyTable';
Query.Open;
try
Query.First;
Query.Edit;
try
BlobField := Query.FieldByName('MyTableField');
Stream := Query.CreateBlobStream(BlobField, bmWrite);
try
TreeView1.SaveToStream(Stream);
finally
Stream.Free;
end;
Query.Post;
except
Query.Cancel;
raise;
end;
finally
Query.Close;
end;
finally
Query.Free;
end;
end;
I'm working on application where I need read and modify some data in Excel file.
For now I was doing it locally and it works, but the thing is that Excel file needs to be on the server.
I used TMemoryStream to first LoadFromFile and next LoadFromStream to dataset as below:
fileStream := TMemoryStream.Create;
fileStream.LoadFromFile(sFileName);
cdsExcel.LoadFromStream(fileStream);
where sFileName
is grabbed based on TOpenDialog.
For now Excel file is in DB and I'm looking for the best way to do read/write operations on it.
Is it any chance to read Excel file from client data set or should I save it locally, do operations and next send it to the server again? The thing is that client shouldn't have access to this file at all.
To open Excel file I use:
Wb := ExApp.Workbooks.Open(sFileName, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, LCID);
so still need original Filename to open the Excel file.
I really appreciate your help and ideas. Thank you!
This example uses Delphi Tokyo 10.2.2, DBISAM as a database, and Excel 2016. This will load an Excel file from a database into an TOleContainer where you can do modifications, then save the Excel file back to the database.
I've created a class called TOleContainerFileIO where most of the work is done. While this example uses DBISAM, TOleContainerFileIO uses TDataset, so any TDataset descendant will work.
Here's the main form code for my sample project.
unit uMainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtnrs, DB, uOleContainerFileIO, dbisamtb,
Vcl.Menus;
type
TForm1 = class(TForm)
tExcelDB: TDBISAMTable;
MainMenu1: TMainMenu;
File1: TMenuItem;
LoadWorksheetfromDB1: TMenuItem;
SaveWorksheettoDB1: TMenuItem;
OleContainer1: TOleContainer;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure LoadWorksheetfromDB1Click(Sender: TObject);
procedure SaveWorksheettoDB1Click(Sender: TObject);
private
fOleContainerFileIO: TOleContainerFileIO;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
begin
tExcelDB.open;
fOleContainerFileIO := TOleContainerFileIO.create(self, OleContainer1);
end;
// TMainmenu menuitem, File > LoadWorksheetFromDB
procedure TForm1.LoadWorksheetfromDB1Click(Sender: TObject);
begin
fOleContainerFileIO.LoadFileFromDB(tExcelDB, 'XLSFile');
end;
// TMainmenu Menuitem, File > Save WorksheetToDB
procedure TForm1.SaveWorksheettoDB1Click(Sender: TObject);
begin
fOleContainerFileIO.SaveFileToDb;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
fOleContainerFileIO.free;
end;
end.
And here's the TOleContainerFileIO class
unit uOleContainerFileIO;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPi, ExtCtrls, OleCtnrs, DB, ComCtrls;
type
TOleContainerFileIO = class(TComponent)
private
fTempfilename: string;
fContainer: TOleContainer;
fDataset: TDataset;
fBlobFieldname: string;
function GetWindowsTempFolder: string;
public
constructor create(AOwner: TComponent; AContainer: TOleContainer); reintroduce;
function Active: Boolean;
procedure LoadFromFile(const AFilename: string);
procedure LoadFileFromDB(ADataset: TDataSet; const ABlobFieldname: string);
procedure SaveFileToDb;
end;
implementation
function TOleContainerFileIO.GetWindowsTempFolder: String;
var
tempFolder: array[0..MAX_PATH] of Char;
begin
GetTempPath(MAX_PATH, #tempFolder);
result := StrPas(tempFolder);
end;
constructor TOleContainerFileIO.create(AOwner: TComponent; AContainer: TOleContainer);
begin
inherited create(AOwner);
fContainer := AContainer;
end;
function TOleContainerFileIO.Active: boolean;
begin
result := ((fDataset.Active) and (fContainer <> nil));
end;
Procedure TOleContainerFileIO.LoadFromFile(const AFilename: string);
begin
fContainer.CreateObjectFromFile(AFilename, false);
fContainer.AutoActivate := aaManual;
fContainer.Iconic := false;
fContainer.CopyOnSave := false;
fContainer.DoVerb(ovShow);
fContainer.Run;
end;
procedure TOleContainerFileIO.LoadFileFromDB(ADataset: TDataSet; const ABlobFieldname: string);
var
fs: TFileStream;
bs: TStream;
begin
fDataset := ADataset;
fBlobFieldname := ABlobFieldname;
if fDataset.Active = False then
raise exception.Create('Load document from Database failed, Dataset is not active');
if fDataset.Fields.FindField(fBlobFieldname)= nil then
raise exception.Create('Load document from Database failed, '+fBlobFieldname+' not found');
bs := fDataset.CreateBlobStream(fDataset.FieldByName(fBlobFieldname), bmRead);
try
bs.seek(0, soFromBeginning);
// create temp file, could use guid.xls here instead of random..
fTempfilename := GetWindowsTempFolder+'Tempfile-'+inttostr(random(100000000))+'.xls';
fs := TFileStream.Create(fTempfilename, fmCreate);
try
fs.CopyFrom(bs, bs.size)
finally
fs.free;
end;
finally
bs.Free;
end;
fContainer.CreateObjectFromFile(fTempfilename, false);
try
fContainer.AutoActivate := aaManual;
fContainer.Iconic := False;
fContainer.CopyOnSave := false;
fContainer.DoVerb(ovShow);
fContainer.Run;
finally
Deletefile(fTempfilename);
end;
end;
procedure TOleContainerFileIO.SaveFileToDb;
var
fs: TFileStream;
bs: TStream;
begin
if fDataset.Active = False then
raise exception.Create('Load Excel from Database failed, Dataset is not active');
if fDataset.Fields.FindField(fBlobFieldname)= nil then
raise exception.Create('Save document to Database failed, '+fBlobFieldname+' does not found');
fContainer.OldStreamFormat := true;
fContainer.SaveAsDocument(fTempfilename);
fDataset.edit;
bs := fDataset.CreateBlobStream(fDataset.FieldByName(fBlobFieldname), bmWrite);
try
try
bs.seek(0, soFromBeginning);
fs := TFileStream.Create(fTempFilename, fmOpenRead, fmShareDenyNone);
try
try
bs.CopyFrom(fs, fs.size);
fDataset.Post;
finally
fs.free;
end;
finally
DeleteFile(fTempfilename);
end;
except
fDataset.Cancel;
raise;
end;
finally
bs.free;
end;
end;
end.
And here's the main form's .DFM in case you want to simply cut and paste to test. You'll need to change the DBISAM table to whatever it is you're using is all..
object Form1: TForm1
Left = 554
Top = 153
Caption = 'Excel OleContainer Test'
ClientHeight = 606
ClientWidth = 885
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnClose = FormClose
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object OleContainer1: TOleContainer
Left = 0
Top = 0
Width = 885
Height = 606
Align = alClient
Caption = 'OleContainer1'
TabOrder = 0
ExplicitLeft = 8
ExplicitTop = 8
ExplicitWidth = 1073
ExplicitHeight = 772
end
object tExcelDB: TDBISAMTable
DatabaseName = 'C:\Users\amazo\Desktop\OleContainerTest'
EngineVersion = '4.44 Build 3'
TableName = 'ExcelDB'
Left = 64
Top = 96
end
object MainMenu1: TMainMenu
Left = 64
Top = 176
object File1: TMenuItem
Caption = 'File'
object LoadWorksheetfromDB1: TMenuItem
Caption = 'Load Worksheet from DB'
OnClick = LoadWorksheetfromDB1Click
end
object SaveWorksheettoDB1: TMenuItem
Caption = 'Save Worksheet to DB'
OnClick = SaveWorksheettoDB1Click
end
end
end
end
I need my program to log a user in from a database. This entails a diver number (like a username) and a password which is already in the database. Unfortunately, I don't know SQL right now and would rather use a technique similar to the one I've done here. I get an error message in run time that says: adotblDiversInfo: Cannot perform this operation on a closed dataset. Thank you so much for your help in advance (:
This is my code:
procedure TfrmHomeScreen.btnLogInClick(Sender: TObject);
var
iDiverNumber : Integer;
sPassword, sKnownPassword : String;
bFlagDiverNumber, bFlagPassword, Result : Boolean;
begin
iDiverNumber := StrToInt(ledDiverNumber.Text);
sPassword := ledPassword.Text;
with frmDM do
adotblDiversInfo.Filtered := False;
frmDM.adotblDiversInfo.Filter := 'Diver Number' + IntToStr(iDiverNumber);
frmDM.adotblDiversInfo.Filtered := True;
if frmDM.adotblDiversInfo.RecordCount = 0 then
ShowMessage(IntToStr(iDiverNumber) + ' cannot be found')
else
begin
sKnownPassword := frmDM.adotblDiversInfo['Password'];
if sKnownPassword = sPassword then
ShowMessage('Login successful')
else
ShowMessage('Incorrect password. Please try again');
end;
end;
The error you're getting is because you've forgotten to open the dataset before attempting to access it. Use frmDM.adoTblDiversInfo.Open; or frmDM.adoTblDiversInfo.Active := True; to do so before trying to use the table.
Your code could be much simpler (and faster) if you change it somewhat. Instead of filtering the entire dataset, simply see if you can Locate the proper record.
procedure TfrmHomeScreen.btnLogInClick(Sender: TObject);
var
iDiverNumber : Integer;
begin
if not frmDM.adoTblDiversInfo.Active then
frmDM.adoTblDiversInfo.Open;
iDiverNumber := StrToInt(ledDiverNumber.Text);
sPassword := ledPassword.Text;
if frmDM.adoTblDiversInfo.Locate('Diver Number', iDiverNumber, []) the
begin
if frmDM.adoTblDiversInfo['Password'] = ledPassword.Text then
ShowMessage('Login successful')
else
ShowMessage('Invalid password. Please try again.');
end
else
ShowMessage(ledDiverNumber.Text);
end;
I'm trying to create my own class object and use it to store various data types for my application, this all works fine when using Published Properties, I can stream these to disk and back with no problems. But I need to stream some Arrays of both integer and strings data types as well.
I understand that Arrays, amongst other data types can't be published properties because Delphi doesn't know how to stream them, I was led to believe you need to use DefineProperties to accomplish this, I've created a test Array of String as a Public property, I can read and write to it just fine, however I need to stream it to disk so i can save it for future use.
The only thing i can find that touches on this subject is here:
Array of a custom class as a property
I've attempted to copy this code and manipulate it to archive what I need but I cannot get it to save, I'm seemingly missing something obvious, my test code I'm using is below, I get no errors with this code, published properties stream to disk ok but my private array does not. Any help would be greatly appreciated.
Thanks.
unit UnitDataSet;
//------------------------------------------------------------------------------
interface
uses System.Classes;
{$M+}
//------------------------------------------------------------------------------
type
TDataStrings = Array [1..50] of String;
TDataSet = class(TComponent)
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader: TReader);
procedure WriteArray(Writer: TWriter);
private
FArrayToSave : TDataStrings;
FPStr : String;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
property Items[I: Integer]: String read GetItem write SetItem;
published
property StringItem : String read FPStr write FPStr;
end;
//------------------------------------------------------------------------------
var
DataSet: TDataSet;
implementation
uses TypInfo, Sysutils;
{ TDataSet }
//------------------------------------------------------------------------------
procedure TDataSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
destructor TDataSet.Destroy;
begin
inherited;
end;
//------------------------------------------------------------------------------
function TDataSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > 0) and (I < Length(FArrayToSave)) then
Result := FArrayToSave[I];
end;
//------------------------------------------------------------------------------
procedure TDataSet.SetItem(I: Integer; Value: string);
begin
if (I > 0) and (I < Length(FArrayToSave)) then
FArrayToSave[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromStream(const Stream: TStream);
var
Reader: TReader;
PropName, PropValue: string;
begin
Reader := TReader.Create(Stream, $FFF);
Stream.Position := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do
begin
PropName := Reader.ReadString;
PropValue := Reader.ReadString;
SetPropValue(Self, PropName, PropValue);
end;
FreeAndNil(Reader);
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToStream(const Stream: TStream);
var
PropName, PropValue: string;
cnt: Integer;
lPropInfo: PPropInfo;
lPropCount: Integer;
lPropList: PPropList;
lPropType: PPTypeInfo;
Writer: TWriter;
begin
lPropCount := GetPropList(PTypeInfo(ClassInfo), lPropList);
Writer := TWriter.Create(Stream, $FFF);
Stream.Size := 0;
Writer.WriteListBegin;
for cnt := 0 to lPropCount - 1 do
begin
lPropInfo := lPropList^[cnt];
lPropType := lPropInfo^.PropType;
if lPropType^.Kind = tkMethod then Continue;
PropName := lPropInfo.Name;
PropValue := GetPropValue(Self, lPropInfo);
Writer.WriteString(PropName);
Writer.WriteString(PropValue);
end;
Writer.WriteListEnd;
FreeAndNil(Writer);
end;
//------------------------------------------------------------------------------
constructor TDataSet.Create(aOwner: TComponent);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TDataSet.ReadArray(Reader: TReader);
var
N: Integer;
begin
N := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do begin
Reader.ReadListBegin;
FArrayToSave[N] := Reader.ReadString;
Reader.ReadListEnd;
Inc(N);
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := 1 to High(FArrayToSave) do begin
Writer.WriteListBegin;
Writer.WriteString(FArrayToSave[I]);
Writer.WriteListEnd;
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
DataSet := TDataSet.Create(Nil);
finalization
FreeAndNil(DataSet);
end.
//------------------------------------------------------------------------------
Here is my Class code re-written with Arioch's suggested code modifications from below:
unit UnitCharSett;
interface
//------------------------------------------------------------------------------
uses System.Classes;
//------------------------------------------------------------------------------
type
TCustomDatSetA = Array [0..99] of String;
TCustomCharSet = class(TComponent)
public
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
end;
TZCharSet = class(TCustomCharSet)
private
FFullArray : TCustomDatSetA;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader:TReader);
procedure WriteArray(Writer:TWriter);
public
property Items[Index: Integer]: string read GetItem write SetItem;
published
end;
//------------------------------------------------------------------------------
implementation
uses
System.TypInfo, System.SysUtils;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(Self);
end;
//------------------------------------------------------------------------------
{ TZCharSett }
//------------------------------------------------------------------------------
procedure TZCharSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
function TZCharSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > -1) and (I < Length(FFullArray)) then
Result := FFullArray[I];
end;
//------------------------------------------------------------------------------
procedure TZCharSet.ReadArray(Reader: TReader);
var
N: Integer;
S: String;
begin
for N := Low(FFullArray) to High(FFullArray) do begin
FFullArray[N] := '';
end;
Reader.ReadListBegin;
N := Reader.ReadInteger;
if N = Length(FFullArray) then
begin
N := Low(FFullArray);
while not Reader.EndOfList do
begin
S := Reader.ReadString;
if N <= High(FFullArray) then
FFullArray[N] := S;
Inc(N);
end;
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.SetItem(I: Integer; Value: string);
begin
if (I > -1) and (I < Length(FFullArray)) then
FFullArray[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
Writer.WriteInteger(Length(FFullArray));
for I := Low(FFullArray) to High(FFullArray) do begin
Writer.WriteString(FFullArray[I]);
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
RegisterClasses([TZCharSet]);
//------------------------------------------------------------------------------
end.
HOW do you actually try to read and write it ? I think you're trying to make complex incompatible things when there instead of using standard methods.
Why not to use standard VCL streaming procedures?
procedure TMyDataSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(self);
end;
procedure TMyDataSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(self);
end;
However if instead of using TFiler and standard VCL streamer you make your custom code using RTTI (GetPropList) - then it would not call those virtual properties APi custom to TFiler and would only show real properties.
So my advice is just to use standard emthods like shown above and to streamline and harden the code.
And since RegisterClass works by the classname you'd better choose another name, not clashing with a real TDataSet from stock DB unit.
Fix the name and do register the class, so VCL streamer could find it by name! For example:
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
S := Reader.ReadString; // even if we would not save it - we should remove it from the input
if N <= High(FArrayToSave) then
FArrayToSave[N] := S;
Inc(N);
end;
Reader.ReadListEnd;
end;
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
Writer.WriteString(FArrayToSave[I]);
end;
Writer.WriteListEnd;
end;
initialization
DataSet := TMyDataSet.Create(Nil);
RegisterClasses([TMyDataSet]);
finalization
DataSet.Free;
end.
Additionally, i think you'd better - for future extensibility - save the array length in DFM.
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteInteger(Length(FArrayToSave));
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
....
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
for N := Low(FArrayToSave) to High(FArrayToSave) do begin
FArrayToSave := ''; // in case DFM would have less elements than 50
N := Reader.ReadInteger;
if N <> Length(FArrayToSave) then... recovery from unexpected DFM version error
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
PS. you do not need {$M+} there since TComponent already is derived from TPersistent
PPS. Wanted to comment upon update in the question, but the phone refuses to do (too long?) so putting it here.
1: since we moved away from using RTTI, the Typinfo unit no more needed in uses. 2: if N = Length(FFullArray) then lacks ELSE path. Okay, now we learned that DFM is broken or incompatible, what then? I think we better raise some error. Or try to remove list of N strings, so next property could be read. Or even remove the list of elements of any type/quantity until list end. Future compatibly is never warranted, but at least some attempt can be done, even just to explicitly halt with error. Skipping reading and silently leaving the reader inside middle of property, so next properties would get crazy, I think is not the way to do it.
And generally David is correct about ignoring incorrect indices in the setter and getter. Unless you would intentionally come with some unusual pattern of implicit item creation from default template in sparse array by setting or getting with "free" "unbound" index (which is no code for either) the better approach at least in Delphi would be "fail early". That is what users of your class would expect by default. So kinda
Procedure class.CheckArrayIdx(const i: integer);
Var mx, mn : integer;
Begin
Mn := low(myarray) ; Mx := high(myarray);
If (i <= mx) and (I >= mn) then exit;
Raise ERangeError.CreateFmt('%s.Items index should be %d <= %d <= %d', [
Self.ClassName, mn, I, mx]) ;
End;
This procedure can be called as 1st line in both setter and getter. Then you can just work with surely correct index value.
If I was using C# I could use the .net framework's SqlDataSourceEnumerator to discover and show a user a list of SQL Server instances on the network.
How can I do that in Delphi?
You can use the NetServerEnum function , filtering by the SV_TYPE_SQLSERVER value in the servertype param, another option is use the SQLOLEDB Enumerator ADO object.
To enumerate all available Microsoft SQL Servers, you can follow this excellent tutorial:
Enumerating available SQL Servers. Retrieving databases on a SQL Server
Included in Zarko's tutorial, there's a link to download the full source code (direct download) which can be useful to quickly test it and check if it fits your needs.
Edit Zarko Gajic's main routine is:
procedure ListAvailableSQLServers(Names : TStrings);
var
RSCon: ADORecordsetConstruction;
Rowset: IRowset;
SourcesRowset: ISourcesRowset;
SourcesRecordset: _Recordset;
SourcesName, SourcesType: TField;
function PtCreateADOObject(const ClassID: TGUID): IUnknown;
var
Status: HResult;
FPUControlWord: Word;
begin
asm
FNSTCW FPUControlWord
end;
Status := CoCreateInstance(
CLASS_Recordset,
nil,
CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER,
IUnknown,
Result);
asm
FNCLEX
FLDCW FPUControlWord
end;
OleCheck(Status);
end;
begin
SourcesRecordset := PtCreateADOObject(CLASS_Recordset) as _Recordset;
RSCon := SourcesRecordset as ADORecordsetConstruction;
SourcesRowset := CreateComObject(ProgIDToClassID('SQLOLEDB Enumerator')) as ISourcesRowset;
OleCheck(SourcesRowset.GetSourcesRowset(nil, IRowset, 0, nil, IUnknown(Rowset)));
RSCon.Rowset := RowSet;
with TADODataSet.Create(nil) do
try
Recordset := SourcesRecordset;
SourcesName := FieldByName('SOURCES_NAME'); { do not localize }
SourcesType := FieldByName('SOURCES_TYPE'); { do not localize }
Names.BeginUpdate;
try
while not EOF do
begin
if (SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE) and (SourcesName.AsString <> '') then
Names.Add(SourcesName.AsString);
Next;
end;
finally
Names.EndUpdate;
end;
finally
Free;
end;
end;
I don't know what I can add without lamering what Zarko's explained.
I use this code:
uses ActiveX,
ComObj,
OleDB,
DB,
ADOInt,
ADODB;
procedure ListAvailableSQLServers(Names: TStringList);
var
RSCon: ADORecordsetConstruction;
Rowset: IRowset;
SourcesRowset: ISourcesRowset;
SourcesRecordset: _Recordset;
SourcesName, SourcesType: TField;
function PtCreateADOObject(const ClassID: TGUID): IUnknown;
var
Status: HResult;
FPUControlWord: Word;
begin
asm
FNSTCW FPUControlWord
end;
Status := CoCreateInstance(
CLASS_Recordset,
nil,
CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER,
IUnknown,
Result);
asm
FNCLEX
FLDCW FPUControlWord
end;
OleCheck(Status);
end;
begin
SourcesRecordset :=
PtCreateADOObject(CLASS_Recordset)
as _Recordset;
RSCon :=
SourcesRecordset
as ADORecordsetConstruction;
SourcesRowset :=
CreateComObject(ProgIDToClassID('SQLOLEDB Enumerator'))
as ISourcesRowset;
OleCheck(SourcesRowset.GetSourcesRowset(
nil,
IRowset, 0,
nil,
IUnknown(Rowset)));
RSCon.Rowset := RowSet;
with TADODataSet.Create(nil) do
try
Recordset := SourcesRecordset;
SourcesName := FieldByName('SOURCES_NAME');
SourcesType := FieldByName('SOURCES_TYPE');
Names.BeginUpdate;
Names.Clear;
try
while not EOF do
begin
if (SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE) and
(SourcesName.AsString <> '') then
Names.Add(SourcesName.AsString);
Next;
end;
finally
Names.EndUpdate;
end;
finally
Free;
end;
end;
procedure GetServer();
var
oItems: TStringList;
begin
oItems:= TStringList.Create;
try
ListAvailableSQLServers(oItems);
// To something with oItems
ShowMessage(oItems.Text);
finally
oItems.Free;
end;
end;