Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 7 years ago.
Improve this question
I added my program to the SendTo. I send two files to it.
They are:
C:\ThisIsMySuperTestHelloWorld\ThisBookIsRedMyPenIsWhite\test.jpg
C:\ThisIsMySuperTestHelloWorld\ThisBookIsRedMyPenIsWhite\hello.jpg
The code below shows C:\ThisIsMySuperTestHelloWorld\ThisBookIsRedMyPenIsWhite\test.jpg#C:\ThisIsMySuperTestHelloWorld\ThisBookIsRedMyPenIsWhite\test.jpg
procedure TForm1.FormCreate(Sender: TObject);
var Files: array of PAnsiChar;
i: Integer;
begin
SetLength(Files, 2);
for i:=0 to 1 do begin
Files[i] := PAnsiChar(ParamStr(2+i));
end;
ShowMessage( Files[0] +'#' + Files[1] );
end;
I use Delphi 6 on Windows7.
Under Delphi Xe3 (still Win7) I changed (both) PAnsiChar to PWideChar and I have the same effect.
My SendTo link links to:
"C:\<PATH_HERE>\Project1.exe" c
and is placed here:
C:\Users\<USER>\AppData\Roaming\Microsoft\Windows\SendTo
What about using strings? For example:
procedure HandleParams;
var Files: array of string;
i: Integer;
begin
SetLength(Files, ParamCount);
for i := 1 to ParamCount do
Files[i-1] := ParamStr(i);
if ParamCount >= 2 then
ShowMessage( Files[0] +'#' + Files[1] );
end;
Your code does not work, because PAnsiChar is only a Pointer and does not store the actual string data. When you assign the string returned from the ParamStr function only a pointer to the (temporary) function result is stored. The actual data is overwritten with the next function call. This can even crash your program when further used.
By the way, your ParamStr index iterates over 2 and 3, with references to the second and third parameter; maybe that's not intended as the arguments start at index 1 (index 0 being the program call itself)?
To solve the issue one has to store the string data, which makes the pointers kinda useless, but anyway, here's a fixed version of your example:
procedure HandleParamsPAnsi;
var Files: array of PAnsiChar;
FilesData: array of AnsiString;
i: Integer;
begin
SetLength(Files, 2);
SetLength(FilesData, 2);
for i:=0 to 1 do begin
FilesData[i] := AnsiString(ParamStr(1+i));
Files[i] := PAnsiChar(FilesData[i]);
end;
ShowMessage( Files[0] + '#' + Files[1] );
end;
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 days ago.
This post was edited and submitted for review 8 days ago and failed to reopen the post:
Original close reason(s) were not resolved
Improve this question
Given an array of pointers where those pointers are to procedures and where they pass a single pointer passed to a procedure, how do you call the passed pointer?
procedure CallPointerProc(Proc : Pointer);
begin
// ???????????
end;
The old DOS method was fairly simple but inline is not available on Windows port so couldn't even convert to ebx,esp, etc..:
inline(
$89/$E3/ {mov bx,sp}
$36/$FF/$1F/ {call dword ptr ss:[bx]}
$83/$C4/$04); {add sp,4}
In general, you should not pass a blank pointer but a type that describes the exact type of subroutine like parameters with their types and return type in case of a function.
Example on how to declares procedure or function types
type
// A procedure with no parameters
TProc = procedure;
// A procedure that expexcts a string
TStringProc = procedure(str: string);
// A function that expects and returns a string
TStringToStringFunc = function(str: string): string;
A function that expects a pointer to a procedure and calls it:
procedure CallPointerProc(Proc : TProc);
begin
Proc();
end;
A function that expects a blank pointer, casts it to a procedure and then calls that:
procedure CallPointerProc(Proc : Pointer);
var
TypedProc: TProc;
begin
TypedProc := TProc(Proc);
TypedProc();
end;
Demo code that works with both definitions of CallPointerProc above. Note that we use the # symbol to get the address of a defined procedure or function.
procedure Demo;
begin
Writeln('Hello World');
end;
begin
CallPointerProc(#Demo);
Readln;
end.
This question already has an answer here:
How Can I Replace StringList.Sort with a Stable Sort in Delphi?
(1 answer)
Closed 1 year ago.
I have the following (simplified) class definition:
TMyObject = class
private
FDoubleValue: Double;
FText: string;
protected
public
constructor Create(ADoubleValue: Double; AText: string);
property DoubleValue: Double read FDoubleValue write FDoubleValue;
property Text: string read FText write FText;
end;
The following sample code, shows how I am sorting the TObjectList<TMyObject> (FMyObjects) and displaying them in a TListBox.
constructor TfrmMain.Create(AOwner: TComponent);
begin
inherited;
FMyObjects := TObjectList<TMyObject>.Create;
FMyObjects.OwnsObjects := true; // Default but for clarity
end;
destructor TfrmMain.Destroy;
begin
FMyObjects.Free;
inherited;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var
ii: Integer;
begin
FMyObjects.Add(TMyObject.Create(100.00, 'Item 1'));
FMyObjects.Add(TMyObject.Create(200.00, 'Item 2'));
FMyObjects.Add(TMyObject.Create(300.00, 'Item 3')); // Duplicate sort value
FMyObjects.Add(TMyObject.Create(300.00, 'Item 4')); // Duplicate sort value
FMyObjects.Add(TMyObject.Create(400.00, 'Item 5'));
ObjectsToListBox;
end;
procedure TfrmMain.SortList;
var
Comparer: IComparer<TMyObject>;
begin
Comparer := TDelegatedComparer<TMyObject>.Create(
function(const MyObject1, MyObject2: TMyObject): Integer
begin
result := CompareValue(MyObject1.DoubleValue, MyObject2.DoubleValue, 0);
end);
FMyObjects.Sort(Comparer);
end;
procedure TfrmMain.ObjectsToListBox;
var
ii: Integer;
begin
ListBox1.Items.Clear;
for ii := 0 to FMyObjects.Count - 1 do
ListBox1.Items.Add(Format('%d - %.1f - %s', [ii, FMyObjects[ii].DoubleValue,
FMyObjects[ii].Text]));
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
SortList;
ObjectsToListBox;
end;
Every time Button1 is clicked (and the list sorted), FMyObjects[2] (Item3) and FMyObjects[3] ('Item4') swap position in the list. In my "real world" (drawing) application this is undesirable.
I also experimented with different values for Epsilon in the CompareValue function call and also a different implementation of the anonymous function (comparing values and returning 1, -1 or 0), but neither seems to make a difference.
Am I missing something (e.g. a property that controls this behavior) or is this "by design" and it cannot be prevented?
This is by design. The internally used Quicksort implementation is not a stable one, so reorder of equal items is expected. To make the sort stable you need to extend your comparer to take that into account. F.i. you can compare the Text properties when the DoubleValue properties are equal.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 2 years ago.
Improve this question
I am attempting to get a program to paste a copy of itself in the windows start-up folder. I have only been able to find the Lazarus function included in FileUtils, CopyFile() but as I'm not using Lazarus this solution doesn't work for me. is there any other way that I can do this in FreePascal? all other things related to files that I can find for FreePascal are referring to text files or the File type.
You may copy one file to another with the oldschool File type and routines:
function CopyFile(const SrcFileName, DstFileName: AnsiString): Boolean;
var
Src, Dst: File;
Buf: array of Byte;
ReadBytes: Int64;
begin
Assign(Src, SrcFileName);
{$PUSH}{$I-}
Reset(Src, 1);
{$POP}
if IOResult <> 0 then
Exit(False);
Assign(Dst, DstFileName);
{$PUSH}{$I-}
Rewrite(Dst, 1);
{$POP}
if IOResult <> 0 then begin
Close(Src);
Exit(False);
end;
SetLength(Buf, 64 * 1024 * 1024);
while not Eof(Src) do begin
{$PUSH}{$I-}
BlockRead(Src, Buf[0], Length(Buf), ReadBytes);
{$POP}
if IOResult <> 0 then begin
Close(Src);
Close(Dst);
Exit(False);
end;
{$PUSH}{$I-}
BlockWrite(Dst, Buf[0], ReadBytes);
{$POP}
if IOResult <> 0 then begin
Close(Src);
Close(Dst);
Exit(False);
end;
end;
Close(Src);
Close(Dst);
Exit(True);
end;
begin
if not CopyFile('a.txt', 'b.txt') then
Halt(1);
end.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 9 years ago.
Improve this question
I'm writing a program for an extended project to simulate the travelling salesman problem. So far I have written it to allow the user to enter a route, as well as 'solving' a route using a nearest neighbour algorithm. I am now trying to write a brute force algorithm to solve for a selection of cities, from 3 cities up to about 13/14. The program is for the purpose of showing how the increase in number of cities leads to an exponential/factorial increase in the time taken to calculate the shortest route. I have tried to write a recursive function but cannot get my head around how it would work. I am in desperate need of some guidance as to how to do this. Any help would be appreciated.
Since there is no tag with Delphi version, then any version suits the TopicStarter just fine. I would base thus draft on XE2 version then. I also would assume that each town is only visited once. I would assume that there is a road network rather than a private airplane, that is between any chosen cities A and B there may be direct path or may not (connection only through other cities).
type TCity = class
public
Name : string;
Routes : TList<TCity>; // available roads to/from this place
LeftFor : integer; // where did the merchant went next; -1 if did not arrived or left, used to iterate all the paths
CameFrom: TCity; // nil initially
.....
End; // writing this draft from phone ( testing official StackOverflow Android app) would not write boilerplate with creating/free in internal objects - do it yourself
Type TPath = TArray<TCity>; // for your app you would add segments and total cost and whatever
Var World: TArray<TCity >; // fill cities and links yourself
AllPaths: TList<TPath>; // create yourself
Current: TList<TCity >; // create yourself
Procedure SaveResult;
Begin AllPaths.Add( Current.ToArray) end;
Function TryNextCity: boolean;
Var c1,c2: TCity; I : integer;
Begin
c1 := Current.Last; // where we are
While true do begin
Inc( c1.LeftFor) ;
If c1.LeftFor >= c1.Routes.Count // tried all ways?
Then Exit( false );
c2 := c1.Routes (. c1.LeftFor .);
if c2 = c1.CameFrom then continue;
if c2.LeftFor >= 0 then continue; // already were there
AddCity(c2);
Exit( True) ;
End;
End;
Procedure AddCity( const City: TCity) ;
Begin
Assert ( not Current.Contains( City) ) ;
If Current.Count = 0
then City.CameFrom := nil //starting point
else City.CameFrom := Current.Last;
City.LeftFor := -1;
Current.Add(City) ;
End;
Procedure Withdraw;
Begin
Assert ( Current.Count > 0);
With Current.Last do begin
CameFrom := nil;
LeftFor := -1;
End;
Current.Delete( Current.Count - 1) ;
End;
Procedure Recurs;
Var DeadEnd : boolean;
Begin
DeadEnd := true;
while TryNextCity() do begin
DeadEnd := false;
Recurs();
end;
if DeadEnd then SaveResult();
Withdraw ();
End;
Procedure RunBruteForce;
Var c: TCity ;
Begin
AllPaths.Clear;
For c in world do begin
Current.Clear;
AddCity( c );
Recurs();
End;
End;
PS. #MartynA looks like I cannot comment my answer now in Android. So my reply is: this questions as is now falls into a triangle between "do my homework", "write a textbook or at least an essay" and "throw a bunch of vague nice ideas, correct per se, but none of which would be detailed and complete enough to be called an answer".
I only started the answer to try new SO app, and only go on for it does not have options to delete the answer.
I have a record that looks similar to:
type
TNote = record
Title : string;
Note : string;
Index : integer;
end;
Simple. The reason I chose to set the variables as string (as opposed to an array of chars) is that I have no idea how long those strings are going to be. They can be 1 char long, 200 or 2000.
Of course when I try to save the record to a type file (file of...) the compiler complains that I have to give a size to string.
Is there a way to overcome this? or a way to save those records to an untyped file and still maintain a sort of searchable way?
Please do not point me to possible solutions, if you know the solution please post code.
Thank you
You can't do it with a typed file. Try something like this, with a TFileStream:
type
TStreamEx = class helper for TStream
public
procedure writeString(const data: string);
function readString: string;
procedure writeInt(data: integer);
function readInt: integer;
end;
function TStreamEx.readString: string;
var
len: integer;
iString: UTF8String;
begin
self.readBuffer(len, 4);
if len > 0 then
begin
setLength(iString, len);
self.ReadBuffer(iString[1], len);
result := string(iString);
end;
end;
procedure TStreamEx.writeString(const data: string);
var
len: cardinal;
oString: UTF8String;
begin
oString := UTF8String(data);
len := length(oString);
self.WriteBuffer(len, 4);
if len > 0 then
self.WriteBuffer(oString[1], len);
end;
function TStreamEx.readInt: integer;
begin
self.readBuffer(result, 4);
end;
procedure TStreamEx.writeInt(data: integer);
begin
self.WriteBuffer(data, 4);
end;
type
TNote = record
Title : string;
Note : string;
Index : integer;
procedure Save(stream: TStream);
end;
procedure TNote.Save(stream: TStream);
var
temp: TMemoryStream;
begin
temp := TMemoryStream.Create;
try
temp.writeString(Title);
temp.writeString(Note);
temp.writeInt(Index);
temp.seek(0, soFromBeginning);
stream.writeInt(temp.size);
stream.copyFrom(temp, temp.size);
finally
temp.Free;
end;
end;
I'll leave the Load procedure to you. Same basic idea, but it shouldn't need a temp stream. With the record size in front of each entry, you can read it and know how far to skip if you're looking for a certain record # instead of reading the whole thing.
EDIT: This was written specifically for versions of Delphi that use Unicode strings. On older versions, you could simplify it quite a bit.
Why not write this out as XML? See my session "Practical XML with Delphi" on how to get started with this.
Another possibility would be to make your records into classes descending form TComponent and store/retreive your data in DFM files.
This Stackoverflow entry shows you how to do that.
--jeroen
PS: Sorry my XML answer was a bit dense; I'm actually on the road for two conferences (BASTA! and DelphiLive! Germany).
Basically what you need to do is very simple: create a sample XML file, then start the Delphi XML Data Binding Wizard (available in Delphi since version 6).
This wizard will generate a unit for you that has the interfaces and classes mapping XML to Delphi objects, and a few helper functions for reading them from file, creating a new object, etc. My session (see the first link above) actually contains most of the details for this process.
The above link is a video demonstrating the usage of the Delphi XML Data Binding Wizard.
You could work with two different files, one that just stores the strings in some convenient way, the other stores the records with a reference to the strings. That way you will still have a file of records for easy access even though you don't know the size of the actual content.
(Sorry no code.)
TNote = record
Title : string;
Note : string;
Index : integer;
end;
could be translated as
TNote = record
Title : string[255];
Note : string[255];
Index : integer;
end;
and use Stream.writebuffer(ANodeVariable, sizeof(TNode), but you said that strings get go over 255 chars in this case IF a string goes over 65535 chars then change WORD to INTEGER
type
TNodeHeader=Record
TitleLen,
NoteLen: Word;
end;
(* this is for writing a TNode *)
procedure saveNodetoStream(theNode: TNode; AStream: TStream);
var
header: TNodeHeader;
pStr: PChar;
begin
...
(* writing to AStream which should be initialized before this *)
Header.TitleLen := Length(theNode.Title);
header.NodeLen := Length(theNode.Note);
AStream.WriteBuffer(Header, sizeof(TNodeHeader);
(* save strings *)
PStr := PChar(theNode.Title);
AStream.writeBuffer(PStr^, Header.TitleLen);
PStr := PChar(theNode.Note);
AStream.writebuffer(PStr^, Header.NoteLen);
(* save index *)
AStream.writebuffer(theNode.Index, sizeof(Integer));
end;
(* this is for reading a TNode *)
function readNode(AStream: TStream): TNode;
var
header: THeader
PStr: PChar;
begin
AStream.ReadBuffer(Header, sizeof(TNodeHeader);
SetLength(Result.Title, Header.TitleLen);
PStr := PChar(Result.Title);
AStream.ReadBuffer(PStr^, Header.TitleLen);
SetLength(Result.Note, Header.NoteLen);
PStr := PChar(Result.Note);
AStream.ReadBuffer(PStr^, Header.NoteLen);
AStream.ReadBuffer(REsult.Index, sizeof(Integer)(* 4 bytes *);
end;
You can use the functions available in this Open Source unit.
It allows you to serialize any record content into binary, including even dynamic arrays within:
type
TNote = record
Title : string;
Note : string;
Index : integer;
end;
var
aSave: TRawByteString;
aNote, aNew: TNote;
begin
// create some content
aNote.Title := 'Title';
aNote.Note := 'Note';
aNote.Index := 10;
// serialize the content
aSave := RecordSave(aNote,TypeInfo(TNote));
// unserialize the content
RecordLoad(aNew,pointer(aSave),TypeInfo(TNote));
// check the content
assert(aNew.Title = 'Title');
assert(aNew.Note = 'Note');
assert(aNew.Index = 10);
end;