Recording and saving .wav Files with TMediaPlayer (Delphi 2010) - delphi

well im really new to the delphi world.
Right now im using the TMediaPlayer to record some sound and save those.
I made a click event for the record button in the TMediaPlayer which executes a SaveFileDialog. The user should type in some filename he would like to save and then after recording the .wav file he can click on the stop button and it will save his recorded .wav file.
Actually it dont event create a file.
I will show some important code parts of my delphi code
if Button = TMPBtnType.btRecord then
begin
SaveDialogSpeichern.Execute;
MediaPlayerSound.FileName := SaveDialogSpeichern.FileName;
MediaPlayerSound.StartRecording;
end
and those for save:
MediaPlayerSound.Stop;
MediaPlayerSound.Save;
I cant use the bass.dll , so i would like to make this with the TMediaPlayer if there is a possible way

I found a solution for my problem.
It seems that the TMediaPlayer do not support creating sound files either Recording sound files.
There is a way to use the WinApi (using mmSystem;)
i used this code:
mciSendString(PChar('OPEN NEW TYPE WAVEAUDIO ALIAS mysound'), nil, 0,
Handle);
mciSendString(PChar('SET mysound TIME FORMAT MS ' +
'BITSPERSAMPLE 8 ' +
'CHANNELS 1 ' +
'SAMPLESPERSEC 8000 ' +
'BYTESPERSEC 8000'),
nil, 0, Handle);
mciSendString(PChar('RECORD mysound'), nil, 0, Handle);
mciSendString(PChar('SAVE mysound "' + SaveDialogSpeichern.FileName+'"' ), nil, 0,
Handle);
mciSendString(PChar('CLOSE mysound'), nil, 0, Handle)
hope this will help anyone with the same problem

And also I want to add this; you can start stop and save your record using this way
procedure TForm1.Button1Click(Sender: TObject); // Record
begin
mciSendString('OPEN NEW TYPE WAVEAUDIO ALIAS mysound', nil, 0, Handle);
mciSendString('SET mysound TIME FORMAT MS ' + // set time
'BITSPERSAMPLE 8 ' + // 8 Bit
'CHANNELS 1 ' + // MONO
'SAMPLESPERSEC 8192 ' + // 8 KHz
'BYTESPERSEC 8192', // 8000 Bytes/s
nil, 0, Handle);
mciSendString('RECORD mysound', nil, 0, Handle);
end;
procedure TForm1.Button2Click(Sender: TObject); // Stop
begin
mciSendString('STOP mysound', nil, 0, Handle)
end;
procedure TForm1.Button3Click(Sender: TObject); // Save
begin
mciSendString(PChar('SAVE mysound "' + '/test.wav'+'"' ), nil, 0,
Handle);
mciSendString('CLOSE mysound', nil, 0, Handle)
end;

I've solved your problem with TMediaPlayer : for recording you have to add the "open" command like this :
void __fastcall TForm1::Button1Click(TObject *Sender)
{
this->SaveDialog1->Execute();
this->MediaPlayer1->FileName = this->SaveDialog1->FileName;
this->MediaPlayer1->Open();
this->MediaPlayer1->StartRecording();
}
Warning : TMediaPlayer do not support creating sound files (as you said), so you must write a new file manually before using it ( weired ).
You can do it manually (just create a new .wav somewhere) or using this code : (I recommand to use this code if you do not want to record on an existing file : )
void __fastcall TForm1::Button1Click(TObject *Sender)
{
this->SaveDialog1->Execute();
this->MediaPlayer1->FileName = this->SaveDialog1->FileName;
TMemoryStream *AudioFile;
AudioFile = new TMemoryStream();
char buffer[43]= 0x52,0x49,0x46,0x46,0x04,0xc0,0x50,0x00,0x57,0x41,0x56,0x45,0x66,0x6D,0x74,0x20,
0x10,0x00,0x00,0x00,0x01,0x00,0x01,0x00,0x44,0xAC,0x00,0x00,0x88,0x58,0x01,0x00,
0x02,0x00,0x10,0x00,0x64,0x61,0x74,0x61,0xE0,0xBF,0x50}; // .wav header example
AudioFile->Write(buffer,43);
char byte=0;
for (int i = 0; i < 49120; i++) // some free audiodata
{
AudioFile->Write(&byte,1);
}
AudioFile->SaveToFile(this->SaveDialog1->FileName);
AudioFile->Clear();
delete AudioFile;
AudioFile=NULL;
this->MediaPlayer1->Open();
this->MediaPlayer1->StartRecording();
}
// stop button :
void __fastcall TForm1::Button2Click(TObject *Sender)
{
this->MediaPlayer1->Stop();
}
//save button :
void __fastcall TForm1::Button3Click(TObject *Sender)
{
this->MediaPlayer1->Save();
this->MediaPlayer1->Close();
}

Related

Indy TFTP Server Exception EIdTFTPAllocationExceeded

I am receiving an EIdTFTPAllocationExceeded exception when transferring a file from me (the server - using the Indy TIdTrivialFTPServer component) to a device. I cannot find any information about what that exception might mean except maybe a disk space problem on the client (which I know is not the case because if I transfer the file through a different TFTP server, there is no problem).
What is the exception trying to tell me?
How do I get around it?
Is there any code that I'm missing?
My TFTP Server code (all of it) for the server is:
__fastcall TTrivialFTPServer::TTrivialFTPServer(TComponent* Owner) : TDataModule(Owner)
{
root = IncludeTrailingPathDelimiter(GetCurrentDir());
}
// ---------------------------------------------------------------------------
void __fastcall TTrivialFTPServer::tftpReadFile(TObject *Sender, UnicodeString &FileName, const TPeerInfo &PeerInfo, bool &GrantAccess, TStream *&AStream, bool &FreeStreamOnComplete)
{
FreeStreamOnComplete = true;
FileName = StringReplace(FileName, "/", "\\", TReplaceFlags() << rfReplaceAll);
FileName = ExtractFileName(FileName);
if (FileExists(root + "files\\" + FileName, false))
{
AStream = new TFileStream(root + "files\\" + FileName, fmOpenRead | fmShareDenyWrite);
GrantAccess = true;
}
else
{
GrantAccess = false;
}
}
After much searching and head scratching, I finally opened the IdTrivialFTPServer.pas file and found the problem. The code states:
if FBlkCounter = High(UInt16) then begin
raise EIdTFTPAllocationExceeded.Create('');
end;
When I added text to the exception I received the added text, so this is where the error is occurring. I tried converting from UInt16 to UInt32, but caused many more problems, so I wanted to see what would happen if I just commented out the check and let the counter roll back to zero.
As It turns out, nothing at all bad happens and the file transfers just fine!

How RichEdit can accept file drag & dropping in BCB or Delphi program?

I'm writing a program that could drag and drop text files onto the form to show and edit it by RichEdit.
I've used ChangeWindowMessageFilterEx to make sure that WM_DROPFILES and WM_COPYDATA can received by my Main Form:
ChangeWindowMessageFilterEx(Handle, WM_DROPFILES, MSGFLT_ADD, NULL);
ChangeWindowMessageFilterEx(Handle, WM_COPYDATA, MSGFLT_ADD, NULL);
ChangeWindowMessageFilter(73 , MSGFLT_ADD);
and call DragAcceptFiles(Handle, true) in the form creation function.
Now the drag operation is valid on any places of the window but except the RichEdit, the cursor shows a deny icon when dragging on the RichEdit.
Dragging on any components, eg. text editors, panels, combo boxes and buttons, on the form can lead to receive the WM_DROPFILES message, but except RichEdit.
Actually, I'm sure that it is possible to drag files on the RichEdit because I have wrote the code last year, but I have lost the source code and forgot it. I'm trying to rebuild the same one now.
Here is the google drive download link to the executable file that I have finished last year. And here is the github url to the uncompleted source code that I'm writing currently.
Thank you for your watching.
I don't know why TRichEdit does not receive WM_DROPFILES when using a message map, but you could handle the WindowProc of the TRichEdit.
A possilble implementation could look like this:
Drop a TRichEdit on your Form
Modify header file
private:
TWndMethod OldWindowProc;
void __fastcall NewWindowProc(TMessage& Msg);
Add implementation
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
OldWindowProc = RichEdit1->WindowProc;
RichEdit1->WindowProc = NewWindowProc;
DragAcceptFiles(RichEdit1->Handle, true);
}
void __fastcall TForm1::NewWindowProc(TMessage& Msg)
{
switch (Msg.Msg) {
case WM_DROPFILES:
{
HDROP DropH = (HDROP)Msg.WParam;
int droppedFileCount = DragQueryFile(DropH, 0xFFFFFFFF, NULL, 0);
TStringList* Buffer = new TStringList();
for (int i = 0; i < droppedFileCount; i++) {
int fileNameLength = DragQueryFile(DropH, i, NULL, 0);
String FileName;
FileName.SetLength(fileNameLength);
DragQueryFile(DropH, i, FileName.w_str(), fileNameLength + 1);
Buffer->LoadFromFile(FileName);
RichEdit1->Lines->AddStrings(Buffer);
RichEdit1->Lines->Add("");
}
delete Buffer;
DragFinish(DropH);
Msg.Result = 0;
break;
}
case CM_RECREATEWND:
DragAcceptFiles(RichEdit1->Handle, true);
break;
default:;
}
OldWindowProc(Msg);
}

Delphi and using Teamspeak SDK

I'm trying to use TeamSpeak3 SDK with my delphi my have come accross a few problems, the code compiles and appears to work, most of the code is example code from example projects, that's except the attempt to read the returned data.
1. Do I free the memory correct?
2. Do I read the returned data from the SDK correct or can it be done in a better way?
I have asked a question about this SDK in another thread, but I was obviously too quick to mark the thread as answered. :/
SDK Documentation:
To get a list of all currently visible clients on the specified virtual server:
unsigned int ts3client_getClientList(serverConnectionHandlerID, result);
uint64 serverConnectionHandlerID;
anyID** result;
Parameters
• serverConnectionHandlerID
ID of the server connection handler for which the list of clients is requested.
• result
Address of a variable that receives a NULL-termianted array of client IDs.
Unless an error occurs, the array must be released using ts3client_freeMemory.
Returns ERROR_ok on success, otherwise an error code as defined in public_errors.h. If an error has occured, the result array is uninitialized and must not be released.
A list of all channels on the specified virtual server can be queried with:
unsigned int ts3client_getChannelList(serverConnectionHandlerID, result);
uint64 serverConnectionHandlerID;
uint64** result;
Parameters
• serverConnectionHandlerID
ID of the server connection handler for which the list of channels is requested.
• result
Address of a variable that receives a NULL-termianted array of channel IDs. Unless an error occurs, the array must be released using ts3client_freeMemory.
Returns ERROR_ok on success, otherwise an error code as defined in public_errors.h. If an error has occured, the result array is uninitialized and must not be released.
unsigned int ts3client_getCaptureDeviceList (modeID, result); const char* modeID; char**** result;
Parameters
• modeID
Defines the playback/capture mode to use. For different modes there might be different device lists. Valid modes are returned ts3client_getDefaultPlayBackMode/ts3client_getDefaultCaptureMode and ts3client_getPlaybackModeList/ts3client_getCaptureModeList.
• result
Address of a variable that receives a NULL-terminated array { { char* deviceName, char* deviceID }, { char* deviceName, char* deviceID }, ... , NULL }.
Unless the function returns an error, the elements of the array and the array itself need to be freed using ts3client_freeMemory.
Returns ERROR_ok on success, otherwise an error code as defined in public_errors.h. In case of an error, the result array is uninitialized and must not be released.
Playback and capture devices available for the given mode can be listed, as well as the current operating systems default. The returned device values can be used to initialize the devices.
To query the default playback and capture device, call
To get a list of all available playback and capture devices for the specified mode, call
unsigned int ts3client_getPlaybackDeviceList(modeID, result);
const char* modeID;
char**** result;
unsigned int ts3client_getCaptureDeviceList(modeID, result);
const char* modeID;
char**** result;
Parameters
• modeID
Defines the playback/capture mode to use. For different modes there might be different device lists. Valid modes are returned by
ts3client_getDefaultPlayBackMode / s3client_getDefaultCaptureMode and ts3client_getPlaybackModeList / ts3client_getCaptureModeList.
• result
Address of a variable that receives a NULL-terminated array { { char* deviceName, char* deviceID }, { char* deviceName, char* deviceID }, ... , NULL }.
Unless the function returns an error, the elements of the array and the array itself need to be freed using ts3client_freeMemory.
Returns ERROR_ok on success, otherwise an error code as defined in public_errors.h. In case of an error, the result array is uninitialized and must not be released.
unsigned int ts3client_startConnection(serverConnectionHandlerID,identity,ip,port,nickname,defaultChannelArray,defaultChannelPassword,serverPassword);
uint64 serverConnectionHandlerID; const char* identity; const
char* ip; unsigned int port; const char* nickname; const char**
defaultChannelArray; // This the thingy I dont get const char*
defaultChannelPassword; const char* serverPassword;
Parameters
• serverConnectionHandlerID
Unique identifier for this server connection. Created with ts3client_spawnNewServerConnectionHandler
• identity
The clients identity. This string has to be created by calling ts3client_createIdentity.
Please note an application should create the identity only once, store the string locally and reuse it for future connections.
• ip
Hostname or IP of the TeamSpeak 3 server.
If you pass a hostname instead of an IP, the Client Lib will try to resolve it to an IP, but the function may block for an unusually long period of time while resolving is taking place. If you are relying on the function to return quickly, we recommend to resolve the hostname yourself (e.g. asynchronously) and then call ts3client_startConnection with the IP instead of the hostname.
• port
UDP port of the TeamSpeak 3 server, by default 9987. TeamSpeak 3 uses UDP. Support for TCP might be added in the future.
• nickname
On login, the client attempts to take this nickname on the connected server. Note this is not necessarily the actually assigned nickname, as the server can modifiy the nickname ("gandalf_1" instead the requested "gandalf") or refuse blocked names.
• defaultChannelArray
String array defining the path to a channel on the TeamSpeak 3 server. If the channel exists and the user has sufficient rights and supplies the correct password if required, the channel will be joined on login.
To define the path to a subchannel of arbitrary level, create an array of channel names detailing the position of the default channel (e.g. "grandparent", "parent", "mydefault", ""). The array is terminated with a empty string.
Pass NULL to join the servers default channel.
• defaultChannelPassword
Password for the default channel. Pass an empty string if no password is required or no default channel is specified.
• serverPassword
Password for the server. Pass an empty string if the server does not require a password.
All strings need to be encoded in UTF-8 format
Important
Client Lib functions returning C-strings or arrays dynamically allocate memory which has to be freed by the caller using ts3client_freeMemory. It is important to only access and release the memory if the function returned ERROR_ok.
Should the function return an error, the result variable is uninitialized, so freeing or accessing it
could crash the application.
See the section Calling Client Lib functions for additional notes and examples.
A printable error string for a specific error code can be queried with
unsigned int ts3client_getErrorMessage(errorCode, error);
unsigned int errorCode;
char** error;
Parameters
• errorCode
The error code returned from all Client Lib functions.
• error
Address of a variable that receives the error message string, encoded in UTF-8 format. Unless the return value of the function is not ERROR_ok, the string should be released with ts3client_freeMemory.
Example:
unsigned int error;
anyID myID;
error = ts3client_getClientID(scHandlerID, &myID); /* Calling some Client Lib function */
if(error != ERROR_ok) {
char* errorMsg;
if(ts3client_getErrorMessage(error, &errorMsg) == ERROR_ok)
{ /* Query printable error */
printf("Error querying client ID: %s\n", errorMsg);
ts3client_freeMemory(errorMsg); /* Release memory */
}
}
type
PPanyID = ^PAnyID;
PanyID = ^anyID;
anyID = word;
var
error: longword;
errormsg: PAnsiChar;
procedure TfrmMain.RequestOnlineClients;
var
ids : PanyID;
pids : PanyID;
aid : anyID;
begin
error := ts3client_getClientList(FTSServerHandlerID, #ids);
if (error <> ERROR_ok) then
begin
if (ts3client_getErrorMessage(error, #errormsg) = ERROR_ok) then
begin
LogMsg(Format('Error requesting online clients: %s', [errormsg]));
ts3client_freeMemory(errormsg);
end;
end else
begin
pids := ids;
while (pids^ <> 0) do
begin
aid := pids^;
LogMsg(format('userid %u',[aid, getUserNickNameById(aid)]));
inc(pids);
end;
ts3client_freeMemory(#pids^); // here's potiential problem
end;
end;
procedure TfrmMain.RequestChannels;
var
ids : PUint64;
pids : PUint64;
aid : uint64;
channelname : PAnsiChar;
begin
error := ts3client_getChannelList(FTSServerHandlerID, #ids);
if (error <> ERROR_ok) then
begin
if (ts3client_getErrorMessage(error, #errormsg) = ERROR_ok) then
begin
LogMsg(Format('Error requesting channels: %s', [errormsg]));
ts3client_freeMemory(errormsg);
end;
end else
begin
pids := ids;
while (pids^ <> 0) do
begin
aid := pids^;
LogMsg(format('channelid %u %s',[aid, getChannelNameById(aid)]));
inc(pids);
end;
ts3client_freeMemory(#pids^);
end;
end;
**// Added details 25-11-2014**
char* defaultMode;
if(ts3client_getDefaultPlayBackMode(&defaultMode) == ERROR_ok) {
char*** array;
if(ts3client_getPlaybackDeviceList(defaultMode, &array) == ERROR_ok) {
for(int i=0; array[i] != NULL; ++i) {
printf("Playback device name: %s\n", array[i][0]); /* First element: Device name */
printf("Playback device ID: %s\n", array[i][1]); /* Second element: Device ID */
/* Free element */
ts3client_freeMemory(array[i][0]);
ts3client_freeMemory(array[i][1]);
ts3client_freeMemory(array[i]);
}
ts3client_freeMemory(array); /* Free complete array */
} else {
printf("Error getting playback device list\n");
}
} else {
printf("Error getting default playback mode\n");
}
Example to query all available playback devices:
char* defaultMode;
if(ts3client_getDefaultPlayBackMode(&defaultMode) == ERROR_ok) {
char*** array;
if(ts3client_getPlaybackDeviceList(defaultMode, &array) == ERROR_ok) {
for(int i=0; array[i] != NULL; ++i) {
printf("Playback device name: %s\n", array[i][0]); /* First element: Device name */
printf("Playback device ID: %s\n", array[i][1]); /* Second element: Device ID */
/* Free element */
ts3client_freeMemory(array[i][0]);
ts3client_freeMemory(array[i][1]);
ts3client_freeMemory(array[i]);
}
ts3client_freeMemory(array); /* Free complete array */
} else {
printf("Error getting playback device list\n");
}
} else {
printf("Error getting default playback mode\n");
}
procedure TfrmMain.ConnectServer2;
var
version : PAnsiChar;
DefaultChannelsArr : PPAnsiChar;
begin
if Connected then Exit;
if not ClientInitialized then
InitializeClient;
// Dbl Check if we can connect
if ClientInitialized then
try
// Connect to server on localhost:9987 with nickname "client", no default channel, no default channel password and server password "secret"
// error := ts3client_startConnection(FTSServerHandlerID, identity, '127.0.0.1', 9987, 'Delphi Client', nil, '', 'secret'); // example connection setup
ts3check(ts3client_startConnection(FTSServerHandlerID, PAnsiChar(FSetup.ClientIdentity), PAnsiChar(FSetup.ServerAddress), FSetup.FServerPort, PAnsiChar(FSetup.NickName), nil, '', PAnsiChar(FSetup.ServerPassword)));
{ TODO -oMe -cImportant : Need to check how to convert ansistrings to UTF8 } // UnicodeToUtf8() // AnsiToUtf8()...
// Query and print client lib version
ts3check(ts3client_getClientLibVersion(#version));
LogMsg(Format('Client lib version: %s', [version]));
ts3client_freeMemory(version); // Release dynamically allocated memory
// Do not set connected here, wait for the callback connected state
except
on e: exception do
begin
UnInitializeClient; // clear the hole thing and start over
LogMsg(Format('Error connecting: %s',[e.Message]));
end;
end;
end;
I'd translate ts3client_getClientList like this:
function ts3client_getClientList(serverConnectionHandlerID: UInt64;
out result: PAnyID): Cardinal; cdecl; external '...';
I think that an out parameter is better than a double pointer. It makes the intent clearer.
Then to call the function I'd write it like this:
var
ids: PAnyID;
idarr: TArray<anyID>;
....
ts3check(ts3client_getClientList(serverConnectionHandlerID, ids));
try
idarr := GetIDs(ids);
finally
ts3check(ts3client_freeMemory(ids));
end;
Here, ts3check is a function that raises an exception if it is passed a return value other than ERROR_ok.
function ts3client_getErrorMessage(error: Cardinal;
out errormsg: PAnsiChar): Cardinal; cdecl; external '...';
....
procedure ts3check(error: Cardinal);
var
errormsg: PAnsiChar;
errorstr: string;
begin
if error = ERROR_ok then
exit;
if ts3client_getErrorMessage(error, #errormsg) <> ERROR_ok then
raise Ets3Error.CreateFmt('Error code %d', [error]);
errorstr := UTF8ToUnicodeString(errormsg);
ts3client_freeMemory(errormsg);
raise Ets3Error.CreateFmt('Error code %d (%s)', [error, errorstr]);
end;
And you can implement GetIDs like this:
function GetIDs(const ids: PAnyID): TArray<anyID>;
var
Count: Integer;
p: PAnyID;
begin
Count := 0;
p := ids;
while p^ <> 0 do
begin
inc(Count);
inc(p);
end;
SetLength(Result, Count);
Count := 0;
p := ids;
while p^ <> 0 do
begin
Result[Count] := p^;
inc(Count);
inc(p);
end;
end;
Now, I don't imagine that you really want an array of IDs. You'd probably be happy to process the IDs inline. I don't want to get into how to do that though because that leads me into code of yours that I cannot see. You won't write the code exactly as I have done above, but you can hopefully use the above as a source of ideas.
The main point in all of this is to try to encapsulate as much of the messy boiler plate code as possible. Wrapping the call to ts3client_getErrorMessage makes the higher level code so much easier to read. Use things like OleCheck and Win32Check as inspiration.
One point I would make is that it feels wrong for this code to live inside a form. Normally it is cleaner to keep such code removed from your UI. Make a wrapper to this library that can be consumed by your UI code. Keep that wrapper in a dedicated unit and so hide away the gnarly details.

PDevMode and DocumentProperties. Error when Migrating between Delphi 7+XE

I have the following function below that gathers the document properties of a PDF that I am printing.
For some reason, in Delphi 7 (running XP), this works great...however, when I try to recompile with Delphi XE using Windows 7, the function always seems to exit failing...dwRet = IDOK!
I noticed that my dwNeeded object in Delphi 7 was 7332, and in XE it is 4294967295!!
Any idea how I can quickly fix this?
Function TPrintPDF.GetPrinterDevMode ( pDevice: PChar ): PDevMode;
Var
pDevModeVar : PDevMode;
pDevModeVar2 : PDevMode;
dwNeeded : DWord;
dwRet : DWord;
Begin
{ Start by opening the printer }
If (Not OpenPrinter (pDevice, PrinterHandle, Nil))
Then Result := Nil;
{ Step 1: Allocate a buffer of the correct size }
dwNeeded := DocumentProperties (0,
PrinterHandle, { Handle to our printer }
pDevice, { Name of the printer }
pDevModevar^, { Asking for size, so these are not used }
pDevModeVar^,
0); { Zero returns buffer size }
GetMem (pDevModeVar, dwNeeded);
{ Step 2: Get the default DevMode for the printer }
dwRet := DocumentProperties (0,
PrinterHandle,
pDevice,
pDevModeVar^, { The address of the buffer to fill }
pDevModeVar2^, { Not using the input buffer }
DM_OUT_BUFFER); { Have the output buffer filled }
{ If failure, cleanup and return failure }
If (dwRet <> IDOK) Then Begin
FreeMem (pDevModeVar);
ClosePrinter (PrinterHandle);
Result := Nil;
End;
{ Finished with the printer }
ClosePrinter (PrinterHandle);
{ Return the DevMode structure }
Result := pDevModeVar;
End; { GetPrinterDevMode Function }
Here are the problems that I can see with your code:
The return value of DocumentProperties is a signed 32 bit integer. It's declared as LONG. A negative value means an error occurred and that's what's happening to you. Only you don't see the negative value because you've stuffed the value into an unsigned integer. Unfortunately XE fails to declare LONG. So change your code to use Integer instead.
You don't check for errors when DocumentProperties returns. If an error occurs, a negative value is returned. Make sure you check for that.
You are passing random garbage in the 4th and 5th parameters to DocumentProperties. I suspect that you can pass nil for both parameters the first time that you call DocumentProperties. You can certainly pass nil for the 5th parameter both times you call the function since you never set DM_IN_BUFFER.
When errors occur you set Result to nil, but you continue executing the rest of the function. Don't do that. Call exit to break out of the function. Assigning to Result does not terminate execution in the way that return does in C-like languages does.
Use a try/finally block to ensure that you call CloseHandle. That allows you to write CloseHandle once only.
Here's the solution that David suggested...Thanks David!
{ ---------------------------------------------------------------------------- }
Function TPrintPDF.GetPrinterDevMode ( pDevice: PChar ): PDevMode;
Var
pDevModeVar : PDevMode;
pDevModeVar2 : PDevMode;
dwNeeded : Long64;
dwRet : Long64;
Begin
Result := Nil;
{ Start by opening the printer }
If (OpenPrinter (pDevice, PrinterHandle, Nil)) Then Begin
Try
{ Step 1: Allocate a buffer of the correct size }
dwNeeded := DocumentProperties (0,
PrinterHandle, { Handle to our printer }
pDevice, { Name of the printer }
Nil, { Asking for size, so these are not used }
Nil,
0); { Zero returns buffer size }
{ Exit if this fails }
If (dwNeeded < 0)
Then Exit;
GetMem (pDevModeVar, dwNeeded);
{ Step 2: Get the default DevMode for the printer }
dwRet := DocumentProperties (0,
PrinterHandle,
pDevice,
pDevModeVar^, { The address of the buffer to fill }
pDevModeVar2^, { Not using the input buffer }
DM_OUT_BUFFER); { Have the output buffer filled }
{ If failure, cleanup and return failure }
If (dwRet <> IDOK) Then Begin
FreeMem (pDevModeVar);
ClosePrinter (PrinterHandle);
Result := Nil;
End;
{ Finished with the printer }
Finally
ClosePrinter (PrinterHandle);
End; { Try }
{ Return the DevMode structure }
Result := pDevModeVar;
End; { If we could open the printer }
End; { GetPrinterDevMode Function }

How can I use external DLL written in C from DELPHI

I need to use external dll to communicate with digital camera and I found program with appropriate dll that enable communication.In dll description I found function that suits my needs. DLL Header Looks like this ....
//-------------------------------------------------------------------
// ReleaseShutter()
// Inputs:
// timeOutInSecs timeout in secs to wait for picture to be
// taken and downloaded (max 60 secs)
// pszFilename option string in which to store the name of the
// saved image. Set to NULL if not required
// numChars length of pszFilename if defined
//
// Returns:// 0 - Success, image saved
// 1 - PSRemote is not running
// 2 - PSRemote is running but camera is not connected
// 3 - Camera is busy
// 4 - Timeout waiting for image to be saved
// 5 - Error releasing shutter
//
// Description:
// Take a picture and optionally wait for it to be saved to disk.
//
//--------------------------------------------------------------------
PSRemoteLIB_API int __stdcall ReleaseShutter( int timeoutInSecs,
char* Filename,int numChars );
Ok, I load dll, use function , get Result status and external program takes a picture but I CAN NOT GET FILENAME BACK!!!! Here is my code
procedure TForm1.Button2Click(Sender: TObject);
var Status: Integer;
Name1: PChar;
DLLHandle: Thandle;
TakePic: Function (T: Integer; Nam: Pchar;Num:Integer):Integer; {$IFDEF WIN32} stdcall; {$ENDIF}
begin DLLHandle := LoadLibrary('PSRemoteLib.dll');
if DLLHandle >= 32 then { success }
begin
Name1:=stralloc(1024);
TakePic := GetProcAddress(DLLHandle, 'ReleaseShutter');
Status:=TakePic(60,Name1,SizeOf(Name1));
label1.Caption:=intTostr(Status);
label2.Caption:=Name1;
FreeLibrary(DLLHandle);
end
else MessageDlg('Error: could not find PSRemoteLib.dll', mtError, [mbOk], 0);
StrDispose(Name1);
end;
I try PChar PWidechar and everything that I found on net but nothing !!!
What I do wrong ???? In the sample .exe that comes with dll and runs in cmd mode this works fine !!!! Program takes picture and report filename ????I have a sample source code and looks like this
case 0: // success if (filename && strlen(filename))
{
cout << "Success, image saved as: " << filename << endl;
}
else
{
cout << "Success, image saved on CF card?" << endl;
}
break;
case 1: cerr << "PSRemote is not running" << endl;
break;
case 2: cerr << "Camera is not connected" << endl;
break;
case 3: cerr << "Camera is busy" << endl;
break;
case 4: cerr << "Timeout waiting for image to be saved" << endl;
break;
default:
cerr << "ERROR: unexpected return status: " << status << endl;
}
}
return nRetCode;
}
PLEASE HELP I NEED THIS !!!
PS also in dll I have similar function
{///----------------------------------------------------------------------- }
{/// GetOutputPath() }
{/// Inputs: }
{/// pszPathname string in which to store the pathname of the }
{/// directory currently being used to save images }
{/// numChars length of pszPathname }
{/// }
{/// Returns: }
{/// 0 - Success, pathname returned in pszPathname }
{/// 1 - PSRemote is not running }
{/// 4 - Some other error }
{/// }
{/// Description: }
{/// Returns the full pathname of the directory used for saving images. }
{/// This is the base directory as specified by SetOutputPath() plus }
{/// any separate directories for year, month or day if selected in }
{/// preferences. }
{/// }
{///----------------------------------------------------------------------- }
var
GetOutputPath: function(pszPathname: PChar;
numChars: var Integer): SREMOTELIB_API INT __STDCALL cdecl {$IFDEF WIN32} stdcall {$ENDIF};
ANd again get status(integer) back but not Pathname ?????
The function wants to get a char buffer. This means you have to allocate this like
Name1 : array[MAX_PATH+1] of AnsiChar;
MAX_PATH is defined in the unit Windows and should be big enough. AnsiChar is for all Delphi versions the equvalent for the C++ char
In the call you have to set the pointer to the buffer and the maximum number of characters
Status := TakePic(60,Name1,MAX_PATH);
If I had to guess, I'd say that you're using Delphi 2009 or later. The meaning of PChar changed in D2009 as part of the Unicode conversion. Try using PAnsiChar instead and it should work.
You have allocated space for the file-name buffer, but you have told the function an incorrect size for that buffer. You used the SizeOf function, which tells the size of the Name1 variable, not the number of characters that the variable's value points to. Name1 is a PChar, so SizeOf(Name1) is the same as SizeOf(PChar), which nowadays is always 4. You allocated 1024 characters, so pass 1024 as the third parameter to ReleaseShutter:
Name1 := StrAlloc(1024);
TakePic := GetProcAddress(DLLHandle, 'ReleaseShutter')
Status:=TakePic(60, Name1, 1024);
If you are using Delphi 2009 or later, you must change all your use of PChar to PAnsiChar, or else you'll be passing the wrong-sized character type to the DLL, which expects single-byte characters.

Resources