ShapefileII.pas needs help Delphi: Shapelib.dll - dll

has anyone had problems with the use of the pascal version of the file 'ShapefileII.pas'?
The OSGEO maintain a DLL to manage shapefile and DBF associated file (https://github.com/OSGeo/shapelib).
I'm trying to create a shp file and the associated .DBF file using Delphi-10.3-Rio. I can create the SHP and DBF file, but I can not add/updade string field data to the DBF file.
I used the steps described in the example file 'dbfadd.c' using the function 'DBFWriteStringAttribute' and 'DBFWriteIntegerAttribute'.
The function does not return any errors, but the string field in DBF file is not updated.
I know that is related to differences PChar C++ and PAnsichar in Delphi 10.3 code.
The Delphi equivalent from C++ is:
function DBFWriteIntegerAttribute(hDBF: DBFHandle;
iShape: LongInt; iField: LongInt; nFieldValue: LongInt): LongInt; cdecl;
function DBFWriteStringAttribute(hDBF: DBFHandle; iShape: LongInt; iField: LongInt; pszFieldValue: PAnsiChar{PChar}): LongInt; cdecl;
//c++ DLL code
{
function DBFWriteIntegerAttribute(hDBF: DBFHandle;iShape: LongInt; iField: LongInt; nFieldValue: LongInt): LongInt; cdecl;
DBFWriteStringAttribute( DBFHandle hDBF, int iShape, int iField,
const char * pszFieldValue );
int}
Please, can anyone help me?
Here my code:
//open dbf file and add/update data
FDBFHandle := DBFOpen(pAnsichar(FileNameDBF), pAnsichar('r+b')); //open a DBF file created
if FDBFHandle = nil then
exit;
iRecord:= DBFGetRecordCount(FDBFHandle); // get record number
DBFWriteIntegerAttribute(FDBFHandle, iRecord, 0, 99 ); //works fine update first field
DBFWriteStringAttribute (FDBFHandle, iRecord, 1, PAnsichar('TEST' ));//NOT WORK BUT RETURN TRUE AND SAVE VALUE '0' TO FIELD
//Using PAnsistring also not work
DBFClose(FDBFHandle);

Solved. Sorry, I found that the problem was due to procedure DBFCreate and not due to DBFWriteStringAttribute. The field was created as an Integer and not as a string. So, the DBFWriteStringAttribute save 0 value.

Related

How to correct this runtime error and why do i get it in Delphi?

I am trying to call a remote API function in Delphi:
procedure TForm4.Button1Click(Sender: TObject);
var
getBalance1 : getBalance;
type1 : consenttype;
begin
getBalance1.consent.type_ := type1;
getBalance1.consent.target := Edit5.Text;
getBalance1.consent.id := Edit6.Text;
Application.ProcessMessages;
valasz := (HTTPRio1 as AccountInfo_PT).getBalance(getBalance1);
end;
But at runtime, I get this error:
Access violation at address 00791D72 in module generate_xml_exe. Write of address 0000000C.
What is this, and how can I correct it? I get this error when I click on the button at runtime.
getBalance is a class of getBalance_Type:
getBalance_Type = class(TRemotable)
private
Fconsent: consent5;
public
constructor Create; override;
destructor Destroy; override;
published
property consent: consent5 Index (IS_UNQL) read Fconsent write Fconsent;
end;
// ************************************************************************ //
// XML : getBalance, global, <element>
// Namespace : http://bbrt.hu/openApiServices/AccountInfo/1/
// Info : Wrapper
// ************************************************************************ //
getBalance = class(getBalance_Type)
private
published
end;
consent5 = class(TRemotable)
private
Ftype_: consentType;
Ftarget: targetType;
Fid: consentIdType;
published
property type_: consentType Index (IS_UNQL) read Ftype_ write Ftype_;
property target: targetType Index (IS_UNQL) read Ftarget write Ftarget;
property id: consentIdType Index (IS_UNQL) read Fid write Fid;
end;
These lines cause the runtime error:
getBalance1.consent.type_ := type1;
getBalance1.consent.target := Edit5.Text;
getBalance1.consent.id := Edit6.Text;
But I don't know how to correct this.
The immediate cause of your Access Violation is that getBalance1 of type getBalance is not created.
All CLASSes in Delphi need to be created, usually via a CONSTRUCTOR named Create. As you don't implicitly create the getBalance1 variable, it contains a random value, and you cannot (safely) access its content.
So, before you start using the getBalance1 variable, you need to create it, as in:
getBalance1 := getBalance.Create;

Generic mechanism for instantiating distinct types in Delphi

I'm trying to use generics to 'genericize' a var that instantiates network transports of different types. I'm not sure if the "generic=no RTTI" rule would invalidate the approach or not, as I'm not yet up to speed with generics.
I've read this post:
What is the correct way to structure this generic object creation , which states the following in the question:
One other thing I would like to do if possible, is to change two
creations:
LAdapter := TSQLiteNativeConnectionAdapter.Create(LFilename)
LAdapter := TFireDacConnectionAdapter.Create(FDatabaseLink.FConnection as TFDConnection, FDatabaseLink.OwnedComponent)
to use an abstract "GetAdapterClass" type function in the parent
TModelDatabaseConnection and just declare the class of adapter in the
child to do something like:
LAdapter := GetAdapterClass.Create...
This is exactly what I would like to do as well. So if you can picture this:
type
TTransport<T> = class(TComponent)
private
...
function GetTransport: TTransport;
procedure SetTransport(AValue: TTransport);
...
public
...
property Transport: TTransport read GetTransport write SetTransport;
...
end;
TTCPIPTransport = class(TTransport<T>)
private
function GetSocket(Index: Integer): String;
procedure SetSocket(Index: Integer; AValue: String);
public
property Socket[Index: Integer]: String read GetSocket write SetSocket;
end;
TServiceTransport = class(TTransport<T>)
private
function GetServiceName: String;
procedure SetServiceName(AValue: String);
public
property ServiceName: String read GetServiceName write SetServiceName;
end;
TISAPITransport = class(TServiceTransport<T>);
THTTPSysTransport = class(TServiceTransport<T>)
private
function GetURL(Index: Integer): String;
procedure SetURL(Index: Integer; AValue: String);
public
property URL[Index: Integer]: read GetURL write SetURL;
end;
etc.
The idea is to create a base class that has all fields/properties/methods that are common to all transports, then have intermediate classes that contain fields/methods/properties that are common only to a certain subset of transports, then have the final version of each transport be specific to the type.
So when I call:
var
trans: TTransport<T> // or TTransport<TTCPIPTransport> etc.
begin
trans := TTransport<TTCPIPTransport>.Create(AOwner,....);
trans.Transport.Socket[0] := '127.0.0.1:8523';
OR
trans := TTransport<TISAPITransport>.Create(AOwner,...);
trans.Transport.ServiceName = 'Foo';
...
etc.
end;
or perhaps even more generic then that, but have each instance of trans - without typecasting - have properties/fields/methods that are specific to the subclass automagically show up.
This way I can have a config screen that allows an administrator to select the type of transport say in a combo box, the have that variable value set the type inside the <> in code, and one set of code handles creation of the object by it's type.
Is this possible using generics?
Here is my first (feeble) attempt at a class factory, never done this before. It works partially (generates the correct class) but isn't accessible as a distinct subclass of the base class without typecasting, which defeats the purpose. Please see inline comments
TWSTransport = class(TComponent)
...
public
constructor Create(AOwner: TComponent); virtual;
....
end;
TWSTransportClass = Class of TWSTransport;
TWSTCPIPTransportClass = class of TWSTCPIPTransport;
TWSHTTPSysTransport = class(TWSServiceTransport);
TWSServiceTransport = class(TWSTransport);
TWSTransportStringConversion = class(TWSTransport);
TWSTransportStreamFormat = class(TWSTransportStringConversion);
TTransportFactory = class(TClassList)
private
function GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
public
procedure RegisterTransportClass(ATransportClass: TWSTransportClass);
property Transport[Index: TWSTransportClass; AOwner: TkbmMWServer]: TWSTransportClass read GetTransport;
end;
function TTransportFactory.GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
begin
if IndexOf(Index) > -1 then
Result := TWSTransportClass(Items[IndexOf(Index)])
else
Result := TWSTransportClass(Index.Create(AOwner));
end;
procedure TTransportFactory.RegisterTransportClass(ATransportClass: TWSTransportClass);
var
index: Integer;
begin
// is the transport registered?
index := IndexOf(ATransportClass);
if index < 0 then
// the transport is not registered, add it to the list
Add(ATransportClass);
end;
initialization
factory := TTransportFactory.Create;
factory.RegisterTransportClass(TWSHTTPSysTransport);
factory.RegisterTransportClass(TWSISAPIRESTTransport);
factory.RegisterTransportClass(TWSTCPIPTransport);
finalization
FreeAndNil(factory);
end.
Here's how I tested it:
procedure TForm4.FormCreate(Sender: TObject);
var
//trans: TWSTCPIPTransport; // this doesn't work
trans: TWSTransport; // this works
begin
trans := factory.Transport[TWSTCPIPTransport,Self];
showmessage(trans.classname); // this shows the correct classname - TWSTCPIPTransport
trans.AddSocket('127.0.0.1:80'); // the compiler gives an error here because this call is specific to a subclass of TWSTransport, TWSTCPIPTransport.
end;
So I'm still missing something... anyone see the mistake?

Calling dynamic DLL elaboration Init from Ada

I want to create a DLL written in ADA that can be called from C++ or from ADA. I've compiled the DLL, and it exports my functions as well as Init and Final.
I now would like to call this DLL from Ada, using dynamic linking. The first half in the code below calls a C++ dll (without Init and Final). This works well. The second half tries to run Init before calling the DLL's function. But the line identified with lots of asterisks won't compile, instead I get error: missing operand.
Where am I going wrong?
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces; use Interfaces;
with Interfaces.C; use Interfaces.c;
with System; use System;
with Ada.Unchecked_Conversion;
procedure SmallCode is
-- Definitions for dynamic DLL interface
type HANDLE is new Unsigned_32;
function LoadLibrary (lpFileName : char_array) return HANDLE;
pragma Import (stdcall, LoadLibrary, "LoadLibrary", "_LoadLibraryA#4"); -- Ada95 doesn't use #n
function GetProcAddress (hModule : HANDLE; lpProcName : char_array) return Address;
pragma Import (stdcall, GetProcAddress, "GetProcAddress", "_GetProcAddress");
--
-- The interface of the function we want to call. It is a pointer (access type) because
-- we will link it dynamically. The function is from AdaCallable.dll
type fnAdaCallable is access function(val : Integer_32) return Integer_32;
pragma Convention (Stdcall, fnAdaCallable);
function To_fnAdaCallable is new Ada.Unchecked_Conversion (Address, fnAdaCallable);
Pointer : Address;
function To_AdaCallable is new Ada.Unchecked_Conversion (Address, fnAdaCallable);
Pointer2 : Address;
type fnInit is access procedure;
pragma Convention (Stdcall, fnInit);
function To_fnInit is new Ada.Unchecked_Conversion (Address, fnInit);
PointerInit : Address;
type fnFinal is access procedure;
pragma Convention (Stdcall, fnFinal);
function To_fnFinal is new Ada.Unchecked_Conversion (Address, fnFinal);
PointerFinal : Address;
Library : HANDLE;
begin
Library := LoadLibrary (To_C ("AdaCallable.dll"));
if Library /= 0 then
Pointer := GetProcAddress(Library, To_C("_fnAdaCallable#4"));
if Pointer /= Null_Address then
declare
result : Integer_32;
begin
result := To_fnAdaCallable(Pointer) (74);
Put_Line("Returned result is " & Integer_32'Image(result));
end;
else
Put_Line("GetProcAddress returned Null_Address");
end if;
else
Put_Line("LoadLibrary returned 0");
end if;
Library := LoadLibrary (To_C ("libDllBuiltFromAda.dll"));
if Library /= 0 then
PointerInit := GetProcAddress (Library, To_C ("DllBuiltFromAdainit"));
if Pointer /= Null_Address then
Put_Line("Calling Init");
To_fnInit (PointerInit); -- ****************************************
Put_Line("Returned from Init");
Pointer2 := GetProcAddress(Library, To_C("AdaCallable#4"));
if Pointer2 /= Null_Address then
declare
result : Integer_32;
begin
result := To_AdaCallable(Pointer2) (74);
Put_Line("Returned result is " & Integer_32'Image(result));
end;
else
Put_Line("GetProcAddress returned Null_Address");
end if;
PointerFinal := GetProcAddress (Library, To_C ("DllBuiltFromAdafinal"));
if Pointer /= Null_Address then
Put_Line("Calling Final");
To_fnFinal (PointerFinal);
Put_Line("Returned from Final");
else
Put_Line ("GetProcAddress for final returned Null_Address");
end if;
else
Put_Line ("GetProcAddress for Init returned Null_Address");
end if;
else
Put_Line("LoadLibrary returned 0");
end if;
Put_Line ("Hello, World!");
end SmallCode;
Given
type Proc_P is access procedure (X : Integer);
P : Proc_P;
you can write
P (42);
as a shorthand for
P.all (42);
but if there’s no argument list to trigger the shortcut you have to be explicit: given
type Parameterless_Proc_P is access procedure;
Q : Parameterless_Proc_P;
you have to call the procedure by writing
Q.all;
By the way, in the line two before your asterisked line, I think you mean PointerInit.

What is a FILE * type in Cocoa,and how properly use it?

I'm trying to run Bash commands from my Cocoa APP. And receive the output. I'm executing all that commands, with Admin Privilege.
How to get output from Admin Priveleges bash script, called from Cocoa?
I guess I need FILE * type to store output, but I don't know how to use it.
What is FILE * type? And how should I use it?
FILE * is a C type and it hasn't got anything to do with Cocoa. It is a handle for an opened file. Here is an example:
#include <stdio.h>
int main () {
FILE *file;
file = fopen("myfile.txt", "w"); // open file
if (!file) { // file couldn't be opened
return 1;
}
fputs("fopen example", file); // write to file
fclose(file);
return 0;
}
In Cocoa, you should normally use NSString's and NSData's writeToURL:atomically:encoding:error: and writeToURL:atomically: methods, respectively.
FILE is an ANSI C structure is used for file handling. fopen function return a file pointer. This pointer, points to a structure that contains information about the file, such as the location of a buffer, the current character position in the buffer, whether the file is being read or written, and whether errors or end of file have occurred. Users don't need to know the details, because the definitions obtained from stdio.h include a structure declaration called FILE. The only declaration needed for a file pointer is exemplified by
FILE *fp;
FILE *fopen(char *name, char *mode);
This says that fp is a pointer to a FILE, and fopen returns a pointer to a FILE. Notice that
FILE is a type name, like int, not a structure tag; it is defined with a typedef.
#include <stdio.h>
int main()
{
FILE * pFile;
char buffer [100];
pFile = fopen ("myfile.txt" , "r");
if (pFile == NULL) perror ("Error opening file");
else
{
while ( ! feof (pFile) )
{
if ( fgets (buffer , 100 , pFile) != NULL )
fputs (buffer , stdout);
}
fclose (pFile);
}
return 0;
}
This example reads the content of a text file called myfile.txt and sends it to the standard output stream.

Is it possible to 'Pin to start menu' using Inno Setup?

I'm using the excellent Inno Setup installer and I notice that some Applications (often from Microsoft) get installed with their launch icon already highly visible ('pinned?') in the start menu (in Windows 7). Am I totally reliant on the most-recently-used algorithm for my icon to be 'large' in the start menu, or is there a way of promoting my application from the installer please?
It is possible to pin programs, but not officially. Based on a code posted in this thread (which uses the same way as described in the article linked by #Mark Redman) I wrote the following:
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
const
// these constants are not defined in Windows
SHELL32_STRING_ID_PIN_TO_TASKBAR = 5386;
SHELL32_STRING_ID_PIN_TO_STARTMENU = 5381;
SHELL32_STRING_ID_UNPIN_FROM_TASKBAR = 5387;
SHELL32_STRING_ID_UNPIN_FROM_STARTMENU = 5382;
type
HINSTANCE = THandle;
HMODULE = HINSTANCE;
TPinDest = (
pdTaskbar,
pdStartMenu
);
function LoadLibrary(lpFileName: string): HMODULE;
external 'LoadLibrary{#AW}#kernel32.dll stdcall';
function FreeLibrary(hModule: HMODULE): BOOL;
external 'FreeLibrary#kernel32.dll stdcall';
function LoadString(hInstance: HINSTANCE; uID: UINT;
lpBuffer: string; nBufferMax: Integer): Integer;
external 'LoadString{#AW}#user32.dll stdcall';
function TryGetVerbName(ID: UINT; out VerbName: string): Boolean;
var
Buffer: string;
BufLen: Integer;
Handle: HMODULE;
begin
Result := False;
Handle := LoadLibrary(ExpandConstant('{sys}\Shell32.dll'));
if Handle <> 0 then
try
SetLength(Buffer, 255);
BufLen := LoadString(Handle, ID, Buffer, Length(Buffer));
if BufLen <> 0 then
begin
Result := True;
VerbName := Copy(Buffer, 1, BufLen);
end;
finally
FreeLibrary(Handle);
end;
end;
function ExecVerb(const FileName, VerbName: string): Boolean;
var
I: Integer;
Shell: Variant;
Folder: Variant;
FolderItem: Variant;
begin
Result := False;
Shell := CreateOleObject('Shell.Application');
Folder := Shell.NameSpace(ExtractFilePath(FileName));
FolderItem := Folder.ParseName(ExtractFileName(FileName));
for I := 1 to FolderItem.Verbs.Count do
begin
if FolderItem.Verbs.Item(I).Name = VerbName then
begin
FolderItem.Verbs.Item(I).DoIt;
Result := True;
Exit;
end;
end;
end;
function PinAppTo(const FileName: string; PinDest: TPinDest): Boolean;
var
ResStrID: UINT;
VerbName: string;
begin
case PinDest of
pdTaskbar: ResStrID := SHELL32_STRING_ID_PIN_TO_TASKBAR;
pdStartMenu: ResStrID := SHELL32_STRING_ID_PIN_TO_STARTMENU;
end;
Result := TryGetVerbName(ResStrID, VerbName) and ExecVerb(FileName, VerbName);
end;
function UnpinAppFrom(const FileName: string; PinDest: TPinDest): Boolean;
var
ResStrID: UINT;
VerbName: string;
begin
case PinDest of
pdTaskbar: ResStrID := SHELL32_STRING_ID_UNPIN_FROM_TASKBAR;
pdStartMenu: ResStrID := SHELL32_STRING_ID_UNPIN_FROM_STARTMENU;
end;
Result := TryGetVerbName(ResStrID, VerbName) and ExecVerb(FileName, VerbName);
end;
The above code first reads the caption of the menu item for pinning or unpinning applications from the string table of the Shell32.dll library. Then connects to the Windows Shell, and for the target app. path creates the Folder object, then obtains the FolderItem object and on this object iterates all the available verbs and checks if their name matches to the one read from the Shell32.dll library string table. If so, it invokes the verb item action by calling the DoIt method and exits the iteration.
Here is a possible usage of the above code, for pinning:
if PinAppTo(ExpandConstant('{sys}\calc.exe'), pdTaskbar) then
MsgBox('Calc has been pinned to the taskbar.', mbInformation, MB_OK);
if PinAppTo(ExpandConstant('{sys}\calc.exe'), pdStartMenu) then
MsgBox('Calc has been pinned to the start menu.', mbInformation, MB_OK);
And for unpinning:
if UnpinAppFrom(ExpandConstant('{sys}\calc.exe'), pdTaskbar) then
MsgBox('Calc is not pinned to the taskbar anymore.', mbInformation, MB_OK);
if UnpinAppFrom(ExpandConstant('{sys}\calc.exe'), pdStartMenu) then
MsgBox('Calc is not pinned to the start menu anymore.', mbInformation, MB_OK);
Please note that even though this code works on Windows 7 (and taskbar pinning also on Windows 8.1 where I've tested it), it is really hacky way, since there is no official way to programatically pin programs to taskbar, nor start menu. That's what the users should do by their own choice.
There's a reason there's no programmatic way to pin things to the taskbar/start menu. In my experience, I have seen the start menu highlight newly-created shortcuts, and that's designed to handle exactly this situation. When you see a newly-installed program show up on the start menu, it's probably because of that algorithm and not because the installer placed it there.
That said, if a new shortcut does not appear highlighted, it may be because the installer extracts a pre-existing shortcut and preserves an old timestamp on it, rather than using the API function to create a shortcut in the start menu.
Have a look at: http://blogs.technet.com/deploymentguys/archive/2009/04/08/pin-items-to-the-start-menu-or-windows-7-taskbar-via-script.aspx