Based on and using the Jedi Demo VHD, I've created a virtual disk, and can mount and dismount it. When mounted, it appears in the Disk Manager as disk 1 "unknown".
Going on to initialize and format it in my code, I am trying with the following code:
procedure TMainForm.BtnInitClick(Sender: TObject);
var RetBytes: DWORD;
hDevice: Cardinal;
Status: LongBool;
Drive: string;
CDsk : TCreateDisk;
PS : TPartitionStyle;
begin
hDevice := INVALID_HANDLE_VALUE;
Drive := GetDiskPath(Edit1.Text);
hDevice:=CreateFile(PChar(Drive), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
try
memoinfo.Lines.Add('CreateFile Success. hDevice = '+hDevice.ToString);
CDsk.PartitionStyle := PARTITION_STYLE_GPT;
CDsk.Gpt.DiskId := TGuid.Empty;
CDsk.Gpt.MaxPartitionCount := 0;
Status := DeviceIoControl(hDevice, IOCTL_DISK_CREATE_DISK, #CDsk, SizeOf(CDsk), nil, 0, #RetBytes, nil);
try
memoinfo.Lines.Add('DeviceControl Success');
except
on e: exception do memoinfo.Lines.Add('DeviceControl Error : '+e.Message);
end;
except
on e: exception do memoinfo.Lines.Add('CreateFile Error : '+e.Message);
end;
end;
GetDiskPath gets '\.\PhysicalDisk1' when edit1.text contains the name of my virtual disk (TestDisk.vhd) and both CreateFile and DeviceIoControl generate 'Success', but the disk in Disk Manager stays unchanged.
What am I doing wrong ?
NB! If you have a answer based on C#, that would be fine too.
Related
InnoSetup v6
Extracting from a FreeArc 0.67 (March 15 2014) Archive using temporary file unarc.exe, during the extraction process the minimize window button is broken.
Using FreeARC because it's the best compression software I can find to date.
During the archive decompression, the GUI window with the status message can't be minimized.
Clicking the window makes windows respond with a deny sound. How do I resolve this?
Something to do with "ProgressPage" or executing the arc command line?
Even with this page disabled, it does the same thing, so probably the setup waiting for the process to finish?
I am constantly working on improving and getting this fix because I got files that are in the 100 GB range that need to be compressed to save on disk space. Making a setup program for the extraction process makes it easier to install those files vs relying on the application that I must install first in order to do an extraction.
EDIT: I switch the extraction program from arc.exe to unarc.exe because arc.exe was crashing due to RAM issues.
#define ArcArchive "Test.arc"
[Setup]
AppName=Test App
DefaultDirName=Test App
AppVerName=Test App
WizardStyle=modern
Compression=lzma2
SolidCompression=yes
Uninstallable=no
DisableProgramGroupPage=yes
[Files]
Source: unarc.exe; Flags: dontcopy
[Code]
var
ProgressPage: TOutputProgressWizardPage;
ProgressFileName: string;
procedure ExtractArc;
var
ArcExtracterPath: string;
ArcArchivePath: string;
TempPath: string;
CommandLine: string;
ResultCode: Integer;
S: AnsiString;
Message: string;
begin
ExtractTemporaryFile('unarc.exe');
ProgressPage := CreateOutputProgressPage('Decompression', 'Decompressing archive...please wait');
ProgressPage.Show;
try
TempPath := ExpandConstant('{tmp}');
ArcExtracterPath := TempPath + '\unarc.exe';
ArcArchivePath := ExpandConstant('{src}\{#ArcArchive}');
ProgressFileName := ExpandConstant('{tmp}\progress.txt');
Log(Format('Expecting progress in %s', [ProgressFileName]));
CommandLine :=
Format('"%s" x -o+ -dp"%s" "%s" > "%s"', [
ArcExtracterPath, ExpandConstant('{app}'), ArcArchivePath, ProgressFileName]);
Log(Format('Executing: %s', [CommandLine]));
CommandLine := Format('/C "%s"', [CommandLine]);
if not Exec(ExpandConstant('{cmd}'), CommandLine, '', SW_HIDE,
ewWaitUntilTerminated, ResultCode) then
begin
RaiseException('Cannot start extracter');
end
else
if ResultCode <> 0 then
begin
LoadStringFromFile(ProgressFileName, S);
Message := Format('Arc extraction failed failed with code %d', [ResultCode]);
Log(Message);
Log('Output: ' + S);
RaiseException(Message);
end
else
begin
Log('Arc extraction done');
end;
finally
{ Clean up }
Log('Arc extraction cleanup');
ProgressPage.Hide;
DeleteFile(ProgressFileName);
end;
Log('Arc extraction end');
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
ExtractArc;
end;
end;
Does anyone have experience with using the Winspool.EnumprinterData API in Delphi?
I found a demo for C++:
https://s-kita.hatenablog.com/entry/20120227/1330353801
I tried to covert it to Delphi as below:
procedure TForm1.GetPrinterData;
var
hPrinter : THandle;
pInfo: PPrinterInfo2;
bytesNeeded: DWORD;
dwRet : DWORD;
dwIndex: DWORD;
pValueName: PWideChar;
pTagName: PWideChar;
cbValueName: DWORD;
pcbValueName : DWORD;
pType: DWORD;
pData: PByte;
cbData: DWORD;
pcbData: PDWORD;
i : Integer;
printername : String;
dwValueNameSize : DWORD;
dwDataSize : DWORD;
begin
hprinter := GetCurrentPrinterHandle;
dwRet := EnumPrinterDataw(hprinter,i,nil,0, pcbValueName,pType,nil,0,pcbData);
end;
Question 1: EnumPrinterDataW result is not the same, even if I chose the same printer, and it often raises an Access Violation error.
Question 2: the API has many pointer type variables, the next step should allocate memory to some variable, but I do not know how to do thqt. For example pData: PByte; Pdata = Allocmem(pcbData^); <==== this is difficult to me, Pdata is TByte, how to allocmem(pcbData^) is TPwidechar how to do this?
This has taken me 2 days to deal with, and it is still a mess !!!!
There are some mistakes in your code:
you are not checking if GetCurrentPrinterHandle() returns a valid printer handle.
you are not initializing your i variable. You need to pass a 0-based index to EnumPrinterData(), but the value of i is indeterminate.
you are not initializing your pcbData variable. EnumPrinterData() expects a pointer to a DWORD variable that will receive the size of the data written to the pData buffer (or the needed size of the pData buffer if pData is nil). But your pcbData is not pointing to a valid DWORD.
Try something more like this:
procedure TForm1.GetPrinterData;
var
hPrinter: THandle;
dwIndex,
dwRet,
dwType,
dwMaxValueNameSize,
dwMaxDataSize,
dwValueNameSize,
dwDataSize: DWORD;
pValueName,
lpData: array of Byte;
sValueName: UnicodeString; // or WideString in D2007 and earlier
begin
hPrinter := GetCurrentPrinterHandle;
if hPrinter = 0 then
Exit; // or raise an exception
try
dwIndex := 0;
dwRet = EnumPrinterData(hPrinter, dwIndex, nil, 0, dwMaxValueNameSize, dwType, nil, 0, #dwMaxDataSize);
if dwRet = ERROR_NO_MORE_ITEMS then
Exit
else if dwRet <> ERROR_SUCCESS then
RaiseLastOSError(dwRet);
SetLength(pValueName, dwMaxValueNameSize);
SetLength(pData, dwMaxDataSize);
repeat
dwValueNameSize := 0;
dwDataSize := 0;
dwRet = EnumPrinterData(hPrinter, dwIndex, PWideChar(pValueName), dwMaxValueNameSize, dwValueNameSize, dwType, PByte(pData), dwMaxDataSize, #dwDataSize);
if dwRet = ERROR_NO_MORE_ITEMS then
Exit
else if dwRet <> ERROR_SUCCESS then
RaiseLasstOSError(dwRet);
SetLength(sValueName, PWideChar(pValueName), (dwValueNameSize div SizeOf(WideChar)) - 1); // -1 for null terminator
// use dwType, sValueName, and pData up to dwDataSize bytes, as needed...
Inc(dwIndex);
until False;
finally
// only if GetCurrentPrinterHandle returns a handle that needs to be closed now...
ClosePrinter(hPrinter);
end;
end;
Thanks for your great great help!
But have more questions, need your help. (sorry, I'm not good at English)
Q1. in your answer :
SetLength(sValueName, PWideChar(pValueName), (dwValueNameSize div SizeOf(WideChar)) - 1); // -1 for null terminator
I dont understnt this SetLength format.....and complier raise an Error :
[DCC Error] Unit1.pas(111): E2008 Incompatible types
Q2. how to get value :
sValueName ----> ValueName : array of Byte, how to get string value form an array of Byte
sorry for my poor ability. I really do not get pointer type Data, need more study
I'm using google distancematrix to calculate travel expenses for emplyees. This all worked fine a while ago, and for several clients running it on location also.
Now I'm researching a bug (that really has nothing to do with this API), and when I make the API call from my debugging environment, I get:
"HttpSendRequest Error 12157: an error occurred in the secure channel support"
When I make the same request from a browser, it all works fine and I get the XML-file I'm requesting.
This is strictly local issue; at the client site the distances are calculated just fine.
Here's the code I use:
function Https_Get(const ServerName,Resource : string;Var Response:AnsiString): Integer;
const
BufferSize=1024*64;
var
hInet : HINTERNET;
hConnect : HINTERNET;
hRequest : HINTERNET;
ErrorCode : Integer;
lpvBuffer : PAnsiChar;
lpdwBufferLength: DWORD;
lpdwReserved : DWORD;
dwBytesRead : DWORD;
lpdwNumberOfBytesAvailable: DWORD;
begin
Result :=0;
Response:='';
hConnect := InternetConnect(hInet, PChar(ServerName), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if hConnect=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetConnect Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
//make the request
hRequest := HttpOpenRequest(hConnect, 'GET', PChar(Resource), HTTP_VERSION, '', nil, INTERNET_FLAG_SECURE, 0);
if hRequest=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpOpenRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
//send the GET request
if not HttpSendRequest(hRequest, nil, 0, nil, 0) then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpSendRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
Coded elsewhere:
sServer = 'maps.googleapis.com';
sParams = '/maps/api/distancematrix/xml?origins=%s+NL&destinations=%s+NL&sensor=false';
...
ResponseCode:=Https_Get(sServer,Format(sParams,[PostcodeVan, PostcodeNaar]), Response);
PostcodeVan and PostcodeNaar are the two ZIP codes and properly filled. Code cancels at the HttpSendRequest statement.
Anyone got any ideas? Especially the fact that it the (server+resource) link in a browser works fine dazzles me!
Thanks in advance!
I am working on creating a chat program. But for some reason my stream won't come through. Could someone check my code and tell me what I am doing wrong?
Client side:
procedure TForm1.Button1Click(Sender: TObject);
var
myStream : TMemoryStream;
chat : String;
begin
//Creating a stream
chat := 'bladibla';
myStream := TMemoryStream.Create();
myStream.Size := Length(Chat);
myStream.WriteBuffer(Pointer(Chat)^, Length(Chat));
//Resetting the stream position
myStream.Position := 0;
//Sending the stream
TcpClient1.Active := true;
TcpClient1.SendStream(myStream);
TcpClient1.Active := false;
//Free the stream
myStream.Free;
end;
Server Side:
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
chat : string;
begin
//Receives the message from the client
ClientSocket.ReceiveBuf(Pointer(Chat)^,Length(Chat),0);
memo1.Lines.Add(chat);
memo1.Lines.Add('------');
end;
If you're using D2009 or later, then when sending, you're cutting the data in half. Also, given you will ultimately be reading the data with ReceiveBuf, it would probably be sensible to prepend a length marker. Less substantively, you also don't need to set the memory stream's Size up front, and should wrap the stream usage in a try/finally block:
procedure TForm1.Button1Click(Sender: TObject);
var
myStream : TMemoryStream;
chat : String;
Len: Int32;
begin
//Creating a stream
chat := 'bladibla';
myStream := TMemoryStream.Create();
try
Len := Length(Chat);
myStream.WriteBuffer(Len, SizeOf(Len));
myStream.WriteBuffer(Pointer(Chat)^, Len * SizeOf(Char));
//Resetting the stream position
myStream.Position := 0;
//Sending the stream
TcpClient1.Active := true;
TcpClient1.SendStream(myStream);
TcpClient1.Active := false;
finally
//Free the stream
myStream.Free;
end;
end;
In the case of the receiving code, you haven't pre-allocated the Chat buffer. As such, Length(Chat) will be 0. Given my suggested code above, we can read off the length marker first:
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
chat : string;
Len: Int32;
begin
//Receives the message from the client
ClientSocket.ReceiveBuf(Len, SizeOf(Len),0);
SetLength(Chat, Len);
ClientSocket.ReceiveBuf(Pointer(Chat)^,Len * SizeOf(Char),0);
memo1.Lines.Add(chat);
memo1.Lines.Add('------');
end;
Lastly... the components used in this code are deprecated, so it might be an idea to investigate Indy instead.
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