As I am looking for AES-128 encryption, I'd like to get Lockbox3 running on Delphi2010.
The first problem here: What/where are the official sources?
The sources from https://sourceforge.net/projects/tplockbox/ don't hold packages for Delphi2010 and also simply don't compile (loads of errors).
https://code.google.com/archive/p/tplockbox/ is not maintained anymore and points to https://github.com/SeanBDurkin/tplockbox.
I downloaded the sources from github, I think in V3.6.3 (version is nowhere mentioned in the sources, right?). The packages can be installed, but e.g. the MakeSampleKey example doesn't compile, as EncryptString doesn't work with AnsiStrings (umfmMakeSampleKey.pas, line 216).
I have then created a project and used the source from the OP of How to AES-128 encrypt a string using a password in Delphi and decrypt in C#?
I changed CipherText from AnsiString to String. The code compiles, but when I run it, it crashes with "Integer overflow" in TPLB3.SHA1.pas, line 264.
Is LockBox3 still maintained and is it usable for Delphi2010? If yes, then how? What do I do wrong? Thx!
Edit: There's another GitHub project hosting LockBox3, namely https://github.com/TurboPack/LockBox3
The recent sources from there do NOT compile under Delphi2010. (see comments under OP for a short list of problems)
Edit: Here's some code I try to use (and fail) - i post it here as I don't manage to post it formatted into a comment:
function LockBox3_EncryptText_AES_128(input: string; password: string): string;
var
Codec: TCodec;
CipherText: String;
begin
Codec := TCodec.Create(nil);
try
Codec.CryptoLibrary := TCryptographicLibrary.Create(Codec);
Codec.StreamCipherId := BlockCipher_ProgID;
Codec.BlockCipherId := Format(AES_ProgId, [128]);
Codec.ChainModeId := CBC_ProgId;
Codec.Password := Password;
Codec.EncryptString(input, CipherText);
Result := string(CipherText);
finally
Codec.Free;
end;
end;
I maintain LockBox 3 at http://lockbox.seanbdurkin.id.au/HomePage .
The repo is at https://github.com/SeanBDurkin/tplockbox .
Yes, it works for D2010.
Update
This works for me, with Delphi 2010 and TPLB3 version 3.6.3
program LB3Demo_D2010;
{$APPTYPE CONSOLE}
uses
SysUtils,
TPLB3.Codec in '..\ExternalLibraries\TPLB3\run\TPLB3.Codec.pas',
TPLB3.CryptographicLibrary in '..\ExternalLibraries\TPLB3\run\TPLB3.CryptographicLibrary.pas',
TPLB3.BlockCipher in '..\ExternalLibraries\TPLB3\run\TPLB3.BlockCipher.pas',
TPLB3.StreamToBlock in '..\ExternalLibraries\TPLB3\run\TPLB3.StreamToBlock.pas',
TPLB3.Decorators in '..\ExternalLibraries\TPLB3\run\TPLB3.Decorators.pas',
TPLB3.StreamCipher in '..\ExternalLibraries\TPLB3\run\TPLB3.StreamCipher.pas',
TPLB3.StreamUtils in '..\ExternalLibraries\TPLB3\run\TPLB3.StreamUtils.pas',
TPLB3.Random in '..\ExternalLibraries\TPLB3\run\TPLB3.Random.pas',
TPLB3.IntegerUtils in '..\ExternalLibraries\TPLB3\run\TPLB3.IntegerUtils.pas',
TPLB3.Compatibility in '..\ExternalLibraries\TPLB3\run\TPLB3.Compatibility.pas',
TPLB3.Asymetric in '..\ExternalLibraries\TPLB3\run\TPLB3.Asymetric.pas',
TPLB3.CodecIntf in '..\ExternalLibraries\TPLB3\run\TPLB3.CodecIntf.pas',
TPLB3.BaseNonVisualComponent in '..\ExternalLibraries\TPLB3\run\TPLB3.BaseNonVisualComponent.pas',
TPLB3.Hash in '..\ExternalLibraries\TPLB3\run\TPLB3.Hash.pas',
TPLB3.HashDsc in '..\ExternalLibraries\TPLB3\run\TPLB3.HashDsc.pas',
TPLB3.AES in '..\ExternalLibraries\TPLB3\run\TPLB3.AES.pas',
TPLB3.Base64 in '..\ExternalLibraries\TPLB3\run\TPLB3.Base64.pas',
TPLB3.CBC in '..\ExternalLibraries\TPLB3\run\TPLB3.CBC.pas',
TPLB3.Constants in '..\ExternalLibraries\TPLB3\run\TPLB3.Constants.pas',
TPLB3.ECB in '..\ExternalLibraries\TPLB3\run\TPLB3.ECB.pas',
TPLB3.MD5 in '..\ExternalLibraries\TPLB3\run\TPLB3.MD5.pas',
TPLB3.SimpleBlockCipher in '..\ExternalLibraries\TPLB3\run\TPLB3.SimpleBlockCipher.pas',
TPLB3.I18n in '..\ExternalLibraries\TPLB3\run\TPLB3.I18n.pas',
TPLB3.CFB_8Bit in '..\ExternalLibraries\TPLB3\run\TPLB3.CFB_8Bit.pas',
TPLB3.CFB_Block in '..\ExternalLibraries\TPLB3\run\TPLB3.CFB_Block.pas',
TPLB3.CTR in '..\ExternalLibraries\TPLB3\run\TPLB3.CTR.pas',
TPLB3.OFB in '..\ExternalLibraries\TPLB3\run\TPLB3.OFB.pas',
TPLB3.PCBC in '..\ExternalLibraries\TPLB3\run\TPLB3.PCBC.pas',
TPLB3.SHA1 in '..\ExternalLibraries\TPLB3\run\TPLB3.SHA1.pas',
TPLB3.SHA2 in '..\ExternalLibraries\TPLB3\run\TPLB3.SHA2.pas',
TPLB3.SVN_Keywords in '..\ExternalLibraries\TPLB3\run\TPLB3.SVN_Keywords.pas',
TPLB3.BinaryUtils in '..\ExternalLibraries\TPLB3\run\TPLB3.BinaryUtils.pas',
TPLB3.PointerArithmetic in '..\ExternalLibraries\TPLB3\run\TPLB3.PointerArithmetic.pas',
TPLB3.CipherUtils in '..\ExternalLibraries\TPLB3\run\TPLB3.CipherUtils.pas',
TPLB3.RSA_Engine in '..\ExternalLibraries\TPLB3\run\TPLB3.RSA_Engine.pas',
TPLB3.RSA_Primitives in '..\ExternalLibraries\TPLB3\run\TPLB3.RSA_Primitives.pas',
TPLB3.HugeCardinal in '..\ExternalLibraries\TPLB3\run\TPLB3.HugeCardinal.pas',
TPLB3.HugeCardinalUtils in '..\ExternalLibraries\TPLB3\run\TPLB3.HugeCardinalUtils.pas',
TPLB3.MemoryStreamPool in '..\ExternalLibraries\TPLB3\run\TPLB3.MemoryStreamPool.pas',
TPLB3.DES in '..\ExternalLibraries\TPLB3\run\TPLB3.DES.pas',
TPLB3.BlowFish in '..\ExternalLibraries\TPLB3\run\TPLB3.BlowFish.pas',
TPLB3.TDES in '..\ExternalLibraries\TPLB3\run\TPLB3.TDES.pas',
TPLB3.TwoFish in '..\ExternalLibraries\TPLB3\run\TPLB3.TwoFish.pas',
TPLB3.XXTEA in '..\ExternalLibraries\TPLB3\run\TPLB3.XXTEA.pas',
TPLB3.DCP.twofish_Modified in '..\ExternalLibraries\TPLB3\run\TPLB3.DCP.twofish_Modified.pas';
const
/// <remarks>Set isProduction to True for a production environment.
/// For a production environment, we want to randomize the PRNG at start-up,
/// for security reasons. For a test environment, we may way to set the seed
/// to be a fixed known value, for purposes of reproducibility and possibly
/// KAT alignment.
/// </remarks>
isProduction: boolean = False;
Seed_ForNonProduction: int64 = 1;
function LockBox3_EncryptText_AES_128( input: string; password: string): string;
var
Codec: TCodec;
begin
Codec := TCodec.Create( nil);
try
Codec.CryptoLibrary := TCryptographicLibrary.Create(Codec);
Codec.StreamCipherId := BlockCipher_ProgID;
Codec.BlockCipherId := Format(AES_ProgId, [128]);
Codec.ChainModeId := CBC_ProgId;
Codec.Password := Password;
Codec.EncryptString( input, result);
Codec.Burn
finally
Codec.Free
end
end;
var
input, output: string;
password: string;
begin
try
if isProduction then
TRandomStream.Instance.Randomize
else
TRandomStream.Instance.Seed := Seed_ForNonProduction;
input := 'Hello world';
WriteLn( 'Compiler = ', Format( '%.1f', [CompilerVersion]));
WriteLn( 'Plaintext = "' + input + '"');
password := 'my-secret';
WriteLn( 'Password (' + {$IFDEF UNICODE} 'UTF-16' {$ELSE} 'UTF-8' {$ENDIF} + ') = "' + password + '"');
WriteLn( 'Seed = ', TRandomStream.Instance.Seed);
output := LockBox3_EncryptText_AES_128( input, password);
Writeln( 'Ciphertext (encoded as base64) = "' + output + '"');
WriteLn( 'Press enter to terminate.');
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Output
When run, the output yields ...
Compiler = 21.0
Plaintext = "Hello world"
Password (UTF-16) = "my-secret"
Seed = 1
Ciphertext (encoded as base64) = "AQAAAAAAAADCpkdd/g8fyEuojQ=="
Related
I am sending alright files (doc, pdf, xls) with english filenames but when I am sending files with greek filenames I am getting on server side ????????? characters for filename & the error message Socket Error 10053, software caused connection abort. Is there a solution for this kind of problem.
Code:
procedure TForm1.LoadFileButtonClick(Sender: TObject);
begin
OpenDialog1.Filter := 'All Files (*.*)';
OpenDialog1.FilterIndex := 1;
if OpenDialog1.Execute then
begin
Edit1.Text := ExtractFileName(OpenDialog1.FileName);
Edit3.Text := OpenDialog1.FileName;
Fstream := TFileStream.Create(OpenDialog1.FileName, fmopenread);
Edit2.Text := inttostr(Fstream.Size);
Fstream.Position := 0;
FreeandNil(FStream);
//Fstream.Free;
end;
end;
procedure TForm1.SendFileButtonClick(Sender: TObject);
var
IncommingText: string;
begin
if (opendialog1.filename<>'') and (CheckBox1.Checked = True) then begin
IdTCPClient1.iohandler.writeln(edit1.text + '#' + edit2.text + ';' + edit3.text + ',');
Sleep(2000);
try
IdTCPClient1.IOHandler.largestream:=true;
Fstream := TFileStream.Create(OpenDialog1.FileName, fmopenread);
IdTCPClient1.IOHandler.Write(Fstream, 0 ,true);
finally
Fstream.Position := 0;
FreeandNil(FStream);
//Fstream.Free;
memo1.Lines.Add('File Sent');
IncommingText := IdTCPClient1.iohandler.readln;
if IncommingText = 'DONE!' then begin
Memo1.Lines.Add('File ' +Edit1.Text +' ' +Edit2.Text +' was received successfully by the Server');
//APPLICATION.ProcessMessages;
end else begin Memo1.Lines.Add('File ' +Edit1.Text +' was not received by the Server'); end;
end; //try - finally
end else begin
showmessage('Please choose a file Or Try to connect to the Server');
end;
end;
Indy's default text encoding is ASCII (because the majority of Internet protocols are still largely ASCII based, unless they define extra extensions to support Unicode). That is why you are getting ? for non-ASCII characters. To send non-ASCII characters, you need to tell Indy which text encoding to use that is compatible with the characters you are exchanging. UTF-8 is usually the best choice for that. There are three ways you can do that:
set the global GIdDefaultTextEncoding variable in the IdGlobal unit. It is set to encASCII by default, you can set it to encUTF8 instead:
procedure TForm1.FormCreate(Sender: TObject);
begin
GIdDefaultTextEncoding := encUTF8;
end;
set the TIdIOHandler.DefStringEncoding property to TIdTextEncoding.UTF8 (or IndyTextEncoding_UTF8 if you are using Indy 10.6+):
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
IdTCPClient1.IOHandler.DefStringEncoding := TIdTextEncoding.UTF8;
// or:
// IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;
pass TIdTextEncoding.UTF8 (or IndyTextEncoding_UTF8) directly to the AByteEncoding parameter of WriteLn():
IdTCPClient1.IOHandler.WriteLn(..., TIdTextEncoding.UTF8);
// or:
// IdTCPClient1.IOHandler.WriteLn(..., IndyTextEncoding_UTF8);
Keep in mind that you are using an Ansi version of Delphi, where string maps to AnsiString, and thus Indy has to perform an additional Ansi-to-Unicode conversion of AnsiString data before it can then apply the specified text encoding to produce the bytes it transmits. Typically, Indy uses the OS's default Ansi encoding to handle that initial conversion (so if your AnsiString data is Greek encoded, and your OS is set to Greek, you will be fine), however you can use the TIdIOHandler.DefAnsiEncoding property, or the ASrcEncoding parameter of WriteLn(), if you need to specify that your AnsiString data is using a different encoding.
As for your socket error, without seeing a call stack leading up to the error, or at least which line of your code is raising it, that is difficult to troubleshoot. My guess is that it is related to you calling ReadLn() inside of the finally block regardless of whether WriteLn() or Write() actually succeeded. That code needs to be moved out of the finally block, it does not belong there.
Try something more like this instead:
procedure TForm1.LoadFileButtonClick(Sender: TObject);
begin
OpenDialog1.Filter := 'All Files (*.*)';
OpenDialog1.FilterIndex := 1;
if OpenDialog1.Execute then
begin
Edit1.Text := ExtractFileName(OpenDialog1.FileName);
Edit3.Text := OpenDialog1.FileName;
// Indy has its own FileSizeByName() function...
Edit2.Text := IntToStr(FileSizeByName(OpenDialog1.FileName));
end;
end;
procedure TForm1.SendFileButtonClick(Sender: TObject);
var
IncommingText: string;
Strm: TFileStream;
begin
if not CheckBox1.Checked then
begin
ShowMessage('Please connect to the Server');
Exit;
end;
if OpenDialog1.FileName = '' then
begin
ShowMessage('Please choose a file');
Exit;
end;
Strm := TFileStream.Create(OpenDialog1.FileName, fmOpenRead);
try
IdTCPClient1.IOHandler.WriteLn(Edit1.Text + '#' + Edit2.Text + ';' + Edit3.Text + ',', TIdTextEncoding.UTF8);
IdTCPClient1.IOHandler.LargeStream := True;
IdTCPClient1.IOHandler.Write(Strm, 0 , True);
finally
Strm.Free;
end;
Memo1.Lines.Add('File Sent');
IncommingText := IdTCPClient1.IOHandler.ReadLn;
if IncommingText = 'DONE!' then begin
Memo1.Lines.Add('File ' + Edit1.Text + ' ' + Edit2.Text + ' was received successfully by the Server');
//APPLICATION.ProcessMessages;
end else
begin
Memo1.Lines.Add('File ' + Edit1.Text + ' was not received by the Server');
end;
end;
Lastly, just an FYI, you are setting the AWriteByteCount parameter of Write() to True, so it is going to transmit the stream size (as an Int64 because of LargeStream=True) before then sending the TStream data, so putting the file size in the WriteLn() data is redundant.
I have the following function with parameters
aFile = a full filename
aFolder = a foldername to copy/move to
aGuid = the guid that the document is assigned
aAction = what to do with the fil (move or copy)
I would guess the line if Trim(NewFile) = Trim(aFile) then Exit should stop the code from doing anything if the old file is the same as the new. But it doesn't. The line if FileExists(NewFile) is executed even if the files are the same.
In my debug log I have
30-05-2013 08:10:34:840 # New file: C:_Delphi_Compiled\HomeSuite\Debug\indbo\computerfladskaerm\968ED02C-21B5-4582-8A49-8463E01ADCB3.pdf
30-05-2013 08:10:34:841 # Old file: C:_Delphi_Compiled\HomeSuite\Debug\Indbo\computerfladskaerm\968ED02C-21B5-4582-8A49-8463E01ADCB3.pdf
and as far as I can tell these names are the same
function DocumentHandle(aFile, aFolder, aGuid: string; aAction: TDocumentAction): string;
const
CopyMsg = 'Der findes allerede en fil med det navn!' + sLineBreak +
'Filen omdøbes derfor til et unikt navn';
var
NewFile: string;
begin
Result := aFile;
try
NewFile := ExtractFileName(aFile);
NewFile := aFolder + NewFile;
if Trim(NewFile) = Trim(aFile) then
Exit;
if FileExists(NewFile) then
begin
NewFile := ExtractFileExt(aFile);
NewFile := aFolder + CleanGuid(aGuid) + NewFile;
MessageDlg(CopyMsg, mtWarning, [mbOk], 0);
end;
case aAction of
daCopy:
begin
if CopyFile(PwideChar(aFile), PwideChar(NewFile), False) then
Result := NewFile;
end;
daMove:
begin
if MoveFile(PwideChar(aFile), PwideChar(NewFile)) then
Result := NewFile;
end;
end;
except
on E: exception do
Logfile.Error('U_Documents.DocumentHandle: ' + E.Message);
end;
end;
Comparison is CaseSensitive you have indbo vs. Indbo in your filenames.
You could compare e.g.
UpperCase(f1)=UpperCase(f2)
or
if SameText(f1,f2) then ...
Rather than comparing strings, which can lead to false positives, you could alternatively convert the file paths to PIDLs using SHParseDisplayName() or IShellFolder.ParseDisplayName(), and then compare those using IShellFolder.CompareIDs(). That would allow you to not only compare files of mixed cases, but also compare short vs long file names, etc.
It looks like you're keeping garbage data in your wide string after the meaningful part, can you try Length(aMessage) on both the string and find out if length is same..
I need to access Amazon REST services like a previous question at " HMAC-SHA256 in Delphi " asked. Since this has to be in D2010 I'm trying to use the latest libeay32.dll to pass the test vectors in RFC 4231:
https://www.rfc-editor.org/rfc/rfc4231
Does anyone have a method that passes these tests in Delphi using this library? The code posted by shunty in the post I referred to passes the first two test vectors as well as the fifth, but it fails in the third and fourth. Those vectors are over 64 bytes and since all of the url's that I need to sign for Amazon are over 64 bytes this is a problem. I haven't been able to figure out if I'm doing something wrong. The OpenSSL test is in hmactest.c, but it only checks EVP_md5 and the test vectors aren't all the same as in the RFC. I need this to work with SHA256 so I can verify against the test vectors in the RFC. I'm using the following constants for the tests (constants now updated for future viewers to fix my copy and paste errors mentioned in the comments below):
const
LIBEAY_DLL_NAME = 'libeay32.dll';
EVP_MAX_MD_SIZE = 64;
//RFC 4231 Test case 1
TEST1_KEY: string = '0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b';
TEST1_DATA: string = '4869205468657265';
TEST1_DIGEST: string = 'b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7';
//RFC 4231 Test case 2
TEST2_KEY = '4a656665';
TEST2_DATA = '7768617420646f2079612077616e7420666f72206e6f7468696e673f';
TEST2_DIGEST = '5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843';
//RFC 4231 Test case 3
TEST3_KEY = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa';
TEST3_DATA = 'dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd';
TEST3_DIGEST = '773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe';
//RFC 4231 Test case 4
TEST4_KEY = '0102030405060708090a0b0c0d0e0f10111213141516171819';
TEST4_DATA = 'cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd';
TEST4_DIGEST = '82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b';
//RFC 4231 Test case 5
TEST5_KEY = '0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c';
TEST5_DATA = '546573742057697468205472756e636174696f6e';
TEST5_DIGEST = 'a3b6167473100ee06e0c796c2955552b';
I don't know how this code by shunty will look pasted in because it looks terrible here (I'm a stackoverflow novice). I used RAND_seed rather than RAND_load_file like he did, but otherwise it's the same:
function TForm1.GetHMAC(const AKey, AData: string): TBytes;
var
key, data: TBytes;
md_len: integer;
res: PByte;
buf: PInteger;
rand_val: Integer;
begin
OpenSSL_add_all_algorithms;
Randomize;
rand_val := Random(100);
GetMem(buf, rand_val);
try
RAND_seed(buf, rand_val);
key := TEncoding.UTF8.GetBytes(AKey);
data := TEncoding.UTF8.GetBytes(AData);
md_len := EVP_MAX_MD_SIZE;
SetLength(Result, md_len);
res := HMAC(EVP_sha256, #key[0], Length(key), #data[0], Length(data), #result[0], md_len);
if (res <> nil) then
SetLength(Result, md_len);
finally
FreeMem(buf);
end;
end;
The code I use to test looks like this. This particular method is for test 3 which fails. The result is bb861233f283aef2ef7aea09785245c9f3c62720c9d04e0c232789f27a586e44, but it should be equal to the constant hex value for TEST3_DIGEST:
procedure TForm1.btnTestCase3Click(Sender: TObject);
var
LBytesDigest: TBytes;
LHashString: string;
LHexDigest: string;
begin
LBytesDigest := GetHMAC(HexToStr(TEST3_KEY), HexToStr(TEST3_DATA));
LHexDigest := LowerCase(BytesToHex(LBytesDigest));
if LHexDigest = TEST3_DIGEST then begin
Memo1.Lines.Add('SUCCESS: Matches test case');
Memo1.Lines.Add(LHexDigest);
end else begin
Memo1.Lines.Add('ERROR: Does not match test case');
Memo1.Lines.Add('Result: ' + LHexDigest);
Memo1.Lines.Add('Test Case: ' + TEST3_DIGEST);
end;
end;
Any ideas? I'm about to give up and just create a .NET app using the library they provide...
You are using D2009+ (as evident by your use of TEncoding), which mean you are dealing with UnicodeString, but you are not taking Unicode into account in your logic. The RFC does not operate on characters, it operates on bytes. Your test data contains hex-encoded strings. When you decode them into (Unicode)String values, many of the resulting characters are outside of the ASCII range of characters, which means they have to be interpretted by Ansi codepages before you can convert them to UTF-8 correctly (which you should not be using in this situation anyway).
You need to change your implementation to decode your hex strings straight to TBytes instead (you can use Classes.HexToBin() for that) so the correct byte values are preserved and passed to HMAC, and get rid of TEncoding.UTF8.GetBytes() completely:
function TForm1.GetHMAC(const AKey, AData: TBytes): TBytes;
var
md_len: integer;
res: PByte;
buf: PInteger;
rand_val: Integer;
begin
OpenSSL_add_all_algorithms;
Randomize;
rand_val := Random(100);
GetMem(buf, rand_val);
try
RAND_seed(buf, rand_val);
md_len := EVP_MAX_MD_SIZE;
SetLength(Result, md_len);
res := HMAC(EVP_sha256, Pointer(AKey), Length(AKey), Pointer(AData), Length(AData), #Result[0], md_len);
if (res <> nil) then
SetLength(Result, md_len);
finally
FreeMem(buf);
end;
end;
function HexToBytes(const S: String): TBytes;
begin
SetLength(Result, Length(S) div 2);
SetLength(Result, HexToBin(PChar(S), Pointer(Result), Length(Result)));
en;
procedure TForm1.btnTestCase3Click(Sender: TObject);
var
LBytesDigest: TBytes;
LHashString: string;
LHexDigest: string;
begin
LBytesDigest := GetHMAC(HexToBytes(TEST3_KEY), HexToBytes(TEST3_DATA));
LHexDigest := LowerCase(BytesToHex(LBytesDigest));
if LHexDigest = TEST3_DIGEST then begin
Memo1.Lines.Add('SUCCESS: Matches test case');
Memo1.Lines.Add(LHexDigest);
end else begin
Memo1.Lines.Add('ERROR: Does not match test case');
Memo1.Lines.Add('Result: ' + LHexDigest);
Memo1.Lines.Add('Test Case: ' + TEST3_DIGEST);
end;
end;
Background
I've been using Win32_DiskDrive to find flash memory (usb pens, SD cards, etc.), but after some tests on other computers I noticed that they weren't always discovered. So I am using Win32_LogicalDisk and since it has DriveType I don't have to associate with two classes (e.g. partition) to find first the drives then their drive letters.
The problem is that external harddrives are detected as DriveType 3 (Local Disk) in LogicalDisk and doesn't have 7 (Supports Removable Media) in Capabilities in DiskDrive. So I can't tell the difference between an internal and external drive.
Question
How do I tell the difference between an internal and an external harddrive using LogicalDisk (or DiskDrive if you really have to) or something third.
Alright. The question has been answered!
Here's the code, if anyone is interested.
program GetWMI_USBConnectedInfo;
{$APPTYPE CONSOLE}
uses
Windows,
Classes,
ActiveX,
Variants,
SysUtils,
WbemScripting_TLB, // Using the .pas supplied by the wrapper as it seems to be the XP version of 1.2
magwmi,
magsubs1;
function CheckType(Str: string): boolean;
var
I: Integer;
Str2: string;
begin
Result := False;
for I := 1 to Length(Str) - 1 do if Str[I] = '\' then begin
Str2 := Copy(Str, 1, I-1);
Str2 := LowerCase(Str2);
if (Str2 = 'usbstor') or (Str2 = 'flashmedia') then
Result := True;
Break;
end;
end;
procedure GetUSBDiskDriveInfo;
var
I, II, III: Integer;
Start, Stop, Freq: Int64;
instances, instances2, instances3: integer ;
WmiResults, WmiResults2, WmiResults3: T2DimStrArray ;
errstr: string ;
begin
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(Start);
try
MagWmiGetInfoEx('.', 'root\CIMV2', '', '', 'SELECT * FROM Win32_DiskDrive', WmiResults, instances, errstr);
for I := 1 to instances do begin
MagWmiGetInfoEx('.', 'root\CIMV2', '', '', 'ASSOCIATORS OF {Win32_DiskDrive.DeviceID=''' + WmiResults[I, 12] + '''} WHERE AssocClass = Win32_DiskDriveToDiskPartition', WmiResults2, instances2, errstr);
for II := 1 to instances2 do begin
MagWmiGetInfoEx('.', 'root\CIMV2', '', '', 'ASSOCIATORS OF {Win32_DiskPartition.DeviceID=''' + WmiResults2[II, 11] + '''} WHERE AssocClass = Win32_LogicalDiskToPartition', WmiResults3, instances3, errstr);
for III := 1 to instances3 do begin
if CheckType(WmiResults[I, 32]) or (Pos('7', WmiResults[I, 3])>0) then begin
Write(WmiResults3[III, 4]);
Write(WmiResults3[III, 39]);
Writeln;
end;
end;
WmiResults3 := nil;
end;
WmiResults2 := nil;
end;
WmiResults := nil;
except
Writeln;
Writeln('error: '+errstr);
end;
Writeln;
QueryPerformanceCounter(Stop);
if (Freq > 0) then
Writeln('It took ' + FormatFloat('0.#0', (Stop-Start) / Freq) + ' seconds to complete.');
end;
begin
try
CoInitialize(nil);
GetUSBDiskDriveInfo;
Readln;
CoUninitialize;
except
on E:Exception do begin
CoUninitialize;
Writeln(E.Classname, ': ', E.Message);
Readln;
end;
end;
end.
One more thing!
Call this a dirty hack or whatever, but I commented out this part of MagWmiGetInfoEx (line 298 in magwmi) in order to make it work:
// if Pos ('SELECT', Arg) = 1 then
wmiObjectSet := wmiServices.ExecQuery (Arg, 'WQL', wbemFlagReturnImmediately, nil)
// else
// wmiObjectSet := wmiServices.InstancesOf (Arg, wbemFlagReturnImmediately or
// wbemQueryFlagShallow, nil)
;
I would suggest sticking with WMI. There is a good delphi wrapper available which includes full source to get you started.
A query to get you started is "SELECT * FROM WIN32_DiskDrive" which would return all of the information for all of the disk drives in your system. the PNPDeviceID field should start with USBSTOR for any USB drives. A good resource for what fields come back is the MSDN website. Just translate the objects into queries.
If your going to be calling this from a thread, you may need to add initialize COM (ComInitialize) before making any calls. Before destroying your thread, call ComUnitialialize.
You can test this package; GLibWMI Components Library in SourceForge. It's a wrapper for work with WMI. Include components like CDiskDriveInfo, CDiskPartitionInfo, CUSBControllerInfo,... that can help you.
Additionally all the code is included. You can evaluate it.
Regards.
Is there a way to assign a multiline string value in Delphi without having to quote each line?
Edit (the specific problem): I have some SQL queries which I want to test outside Delphi. When copying the queries it is a bit of overhead to add and replace quotes every time.
Here's code for an application you can add to the IDE's Tools menu that might help. It was posted a while back to one of the CodeGear newsgroups by TeamB member Peter Below:
program ClipToStringConst;
// Remove the dot from the line below for a console app,
// per Rob Kennedy's comment. It works fine without being
// a console app.
{.$APPTYPE CONSOLE}
uses
Windows,
Classes,
Sysutils,
APIClipboard;
const
cIndent = ' '; // 2 spaces
cSingleQuote = '''';
EndChar : array [Boolean] of Char = ('+',';');
procedure Process;
var
SL: TStringlist;
i, max: Integer;
begin
if ClipboardHasFormat( CF_TEXT ) then
begin
SL := TStringlist.Create;
try
SL.Text := ClipboardAsString;
max := SL.count-1;
for i:= 0 to max do
SL[i] := cIndent +
AnsiQuotedStr( TrimRight(SL[i])+#32, cSingleQuote ) +
EndChar[i = max];
StringToClipboard( SL.Text );
finally
SL.Free;
end; { Finally }
end;
end;
begin
try
Process;
except
on E: Exception do
ShowException( E, ExceptAddr );
end;
end.
Just select the text in the SQL management tool after you've tested it and copy it to the clipboard. Switch to the Delphi Code Editor, place the insertion point where you want the constant text to appear, choose 'Clipboard To Const' or whatever you called it from the Tools menu, and then Ctrl+V to paste it into the editor.
It's a pretty handy little tool. You can also modify it to work the opposite way (ConstantToClipboard) to remove the source formatting and revert back to raw SQL, although I haven't bothered to do so yet.
EDIT: Missed a unit (APIClipboard). This needs to be a separate unit, obviously. Again, thanks to Peter Below:
{== Unit APIClipboard =================================================}
{: Clipboard access routines using only API functions
#author Dr. Peter Below
#desc Version 1.0 created 5 Juli 2000<BR>
Current revision 1.0<BR>
Last modified 5 Juli 2000<P>
This unit provides simply clipboard access routines that do not rely on
the VCL Clipbrd unit. That unit drags in Dialogs and Forms and a major
part of the VCL as a consequence, not appropriate for simple console
or non-form programs. This unit uses only API routines, the only VCL
units used are Classes (for exceptions and streams) and SysUtils.
}
{=====================================================================}
unit APIClipboard;
interface
uses
Windows, Classes;
procedure StringToClipboard( const S: String );
function ClipboardAsString: String;
procedure CopyDataToClipboard( fmt: DWORD; const data; datasize: Integer;
emptyClipboardFirst: Boolean = true );
procedure CopyDataFromClipboard( fmt: DWORD; S: TStream );
function ClipboardHasFormat( fmt: DWORD ): Boolean;
implementation
uses
Sysutils;
type
{: This is an internal exception class used by the <see unit=APIClipboard> }
EClipboardError = class( Exception )
public
constructor Create( const msg: String );
end;
resourcestring
eSystemOutOfMemory =
'could not allocate memory for clipboard data.';
eLockfailed =
'could not lock global memory handle.';
eSetDataFailed =
'could not copy data block to clipboard.';
eCannotOpenClipboard =
'could not open the clipboard.';
eErrorTemplate =
'APIClipboard: %s'#13#10+
'System error code: %d'#13#10+
'System error message: %s';
{-- EClipboardError.Create --------------------------------------------}
{: Creates a new EclipboardError object
#Param msg is the string to embed into the error message
#Precondition none
#Postcondition none
#desc Composes an error message that contains the passed message and the
API error code and matching error message. The CreateFmt constructor
inherited from the basic Exception class is used to do the work.
Created 5.7.2000 by P. Below
}{---------------------------------------------------------------------}
constructor EClipboardError.Create( const msg: String );
begin { Create }
CreateFmt( eErrorTemplate,
[msg, GetLastError, SysErrorMessage(GetLastError)] );
end; { EClipboardError.Create }
{-- DataToClipboard ---------------------------------------------------}
{: Copies a block of memory to the clipboard in a given format
#Param fmt is the clipboard format to use
#Param data is an untyped const parameter that addresses the data to copy
#Param datasize is the size of the data, in bytes
#Precondition The clipboard is already open. If not an EClipboardError
will result. This precondition cannot be asserted, unfortunately.
#Postcondition Any previously exisiting data of this format will have
been replaced by the new data, unless datasize was 0 or we run into an
exception. In this case the clipboard will be unchanged.
#desc Uses API methods to allocate and lock a global memory block of
approproate size, copies the data to it and submits the block to the
clipboard. Any error on the way will raise an EClipboardError
exception.<BR>
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure DataToClipboard( fmt: DWORD; Const data; datasize: Integer );
var
hMem: THandle;
pMem: Pointer;
begin { DataToClipboard }
if datasize <= 0 then
Exit;
hMem := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, datasize );
if hmem = 0 then
raise EClipboardError.Create( eSystemOutOfMemory );
pMem := GlobalLock( hMem );
if pMem = nil then
begin
GlobalFree( hMem );
raise EClipboardError.Create( eLockFailed );
end;
Move( data, pMem^, datasize );
GlobalUnlock( hMem );
if SetClipboardData( fmt, hMem ) = 0 then
raise EClipboardError( eSetDataFailed );
// Note: API docs are unclear as to whether the memory block has
// to be freed in case of failure. Since failure is unlikely here
// lets blithly ignore this issue for now.
end; { DataToClipboard }
{-- DataFromClipboard -------------------------------------------------}
{: Copies data from the clipboard into a stream
#Param fmt is the clipboard format to look for
#Param S is the stream to copy to
#precondition S <> nil
#postcondition If data was copied the streams position will have moved
#desc Tries to get a memory block for the requested clipboard format.
Nothing
further is done if this fails (because the format is not available or
the clipboard is not open, we treat neither as error here), otherwise
the memory handle is locked and the data copied into the stream. <P>
Note that we cannot determine the actual size of the data originally
copied to the clipboard, only the allocated size of the memory block!
Since GlobalAlloc works with a granularity of 32 bytes the block may be
larger than required for the data and thus the stream may contain some
spurious bytes at the end. There is no guarantee that these bytes will
be 0. <P>
If the memory handle obtained from the clipboard cannot be locked we
raise an <see class=EClipboardError> exception.
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure DataFromClipboard( fmt: DWORD; S: TStream );
var
hMem: THandle;
pMem: Pointer;
datasize: DWORD;
begin { DataFromClipboard }
Assert( Assigned( S ));
hMem := GetClipboardData( fmt );
if hMem <> 0 then
begin
datasize := GlobalSize( hMem );
if datasize > 0 then
begin
pMem := GlobalLock( hMem );
if pMem = nil then
raise EclipboardError.Create( eLockFailed );
try
S.WriteBuffer( pMem^, datasize );
finally
GlobalUnlock( hMem );
end;
end;
end;
end; { DatafromClipboard }
{-- CopyDataToClipboard -----------------------------------------------}
{: Copies a block of memory to the clipboard in a given format
#Param fmt is the clipboard format to use
#Param data is an untyped const parameter that addresses the data to copy
#Param datasize is the size of the data, in bytes
#Param emptyClipboardFirst determines if the clipboard should be emptied,
true by default
#Precondition The clipboard must not be open already
#Postcondition If emptyClipboardFirst is true all prior data will be
cleared from the clipboard, even if datasize is <= 0. The clipboard
is closed again.
#desc Tries to open the clipboard, empties it if required and then tries to
copy the passed data to the clipboard. This operation is a NOP if
datasize <= 0. If the clipboard cannot be opened a <see
class=EClipboardError>
is raised.
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure CopyDataToClipboard( fmt: DWORD; const data; datasize: Integer;
emptyClipboardFirst: Boolean = true );
begin { CopyDataToClipboard }
if OpenClipboard( 0 ) then
try
if emptyClipboardFirst then
EmptyClipboard;
DataToClipboard( fmt, data, datasize );
finally
CloseClipboard;
end
else
raise EclipboardError.Create( eCannotOpenClipboard );
end; { CopyDataToClipboard }
{-- StringToClipboard -------------------------------------------------}
{: Copies a string to clipboard in CF_TEXT clipboard format
#Param S is the string to copy, it may be empty.
#Precondition The clipboard must not be open already.
#Postcondition Any prior clipboard content will be cleared, but only
if S was not empty. The clipboard is closed again.
#desc Hands the brunt of the work off to <See routine=CopyDataToClipboard>,
but only if S was not empty. Otherwise nothing is done at all.<BR>
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure StringToClipboard( const S: String );
begin
if Length(S) > 0 Then
CopyDataToClipboard( CF_TEXT, S[1], Length(S)+1);
end; { StringToClipboard }
{-- CopyDataFromClipboard ---------------------------------------------}
{: Copies data from the clipboard into a stream
#Param fmt is the clipboard format to look for
#Param S is the stream to copy to
#Precondition S <> nil<P>
The clipboard must not be open already.
#Postcondition If data was copied the streams position will have moved.
The clipboard is closed again.
#desc Tries to open the clipboard, and then tries to
copy the data to the passed stream. This operation is a NOP if
the clipboard does not contain data in the requested format.
If the clipboard cannot be opened a <see class=EClipboardError>
is raised.
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure CopyDataFromClipboard( fmt: DWORD; S: TStream );
begin { CopyDataFromClipboard }
Assert( Assigned( S ));
if OpenClipboard( 0 ) then
try
DataFromClipboard( fmt , S );
finally
CloseClipboard;
end
else
raise EclipboardError.Create( eCannotOpenClipboard );
end; { CopyDataFromClipboard }
{-- ClipboardAsString -------------------------------------------------}
{: Returns any text contained on the clipboard
#Returns the clipboards content if it contained something in CF_TEXT
format, or an empty string.
#Precondition The clipboard must not be already open
#Postcondition The clipboard is closed.
#desc If the clipboard contains data in CF_TEXT format it is copied to a
temp memory stream, zero-terminated for good measure and copied into
the result string.
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
function ClipboardAsString: String;
const
nullchar: Char = #0;
var
ms: TMemoryStream;
begin { ClipboardAsString }
if not IsClipboardFormatAvailable( CF_TEXT ) then
Result := EmptyStr
else
begin
ms:= TMemoryStream.Create;
try
CopyDataFromClipboard( CF_TEXT , ms );
ms.Seek( 0, soFromEnd );
ms.WriteBuffer( nullChar, Sizeof( nullchar ));
Result := PChar( ms.Memory );
finally
ms.Free;
end;
end;
end; { ClipboardAsString }
{-- ClipboardHasFormat ------------------------------------------------}
{: Checks if the clipboard contains data in the specified format
#Param fmt is the format to check for
#Returns true if the clipboard contains data in this format, false
otherwise
#Precondition none
#Postcondition none
#desc This is a simple wrapper around an API function.
Created 5.7.2000 by P. Below
}{---------------------------------------------------------------------}
function ClipboardHasFormat( fmt: DWORD ): Boolean;
begin { ClipboardHasFormat }
Result := IsClipboardFormatAvailable( fmt );
end; { ClipboardHasFormat }
end.
Sample use:
Prepare the text in your SQL editor, text editor, or whatever:
SELECT
lname,
fname,
dob
FROM
employees
Select all of the text, and copy to the clipboard using Ctrl+C.
Switch to the IDE's Code Editor, run the ClipboardToStringConst application (using the Tools menu item you added, or whatever other means you want). Place the editor's cursor (insertion point) where you want the constant text to appear, and press Ctrl+V to paste in the text.
const
MySQLText = | // The pipe indicates the insertion point.
The result:
const
MySQLText = 'SELECT '+
' lname, '+
' fname, '+
' dob '+
'FROM '+
' employees ';
You mean something like this?
myStr := 'first line'#13#10'secondline'#13#10'thirdline';
We had the same problem, and finally we created a small IDE plugin (merged with existing solutions). That creates two extra menu items (Copy and Paste extra). One of this pastes the formatted content of the clipboard to the code editor, the other does the same thing in reverse (copy the content of the selection to the clipboard and removes the extra charachters).
To use this:
Create new Package in Delphi
Add to "designide" to requires section (and remove anything else)
Create new Unit, and copy the code
Build and Install
Sample code:
unit ClipboardWizard;
interface
uses
Windows, SysUtils, Classes, ToolsAPI,
{$ifdef VER280} // XE7
VCL.Menus
{$else}
Menus
{$endif};
type
TClipboardWizard = class(TInterfacedObject, IOTAWizard)
private
FMainMenuItem, FCopyMenuItem, FPasteMenuItem: TMenuItem;
// Formatting
function GetFormattedString: string;
function RemoveUnneededChars(const Value: string): string;
// Menu events
procedure CopyToClipboard(Sender: TObject);
procedure PasteFromClipboard(Sender: TObject);
public
// TObject
constructor Create;
destructor Destroy; override;
// IOTANotifier
procedure AfterSave;
procedure BeforeSave;
procedure Destroyed;
procedure Modified;
// IOTAWizard
function GetIDString: string;
function GetName: string;
function GetState: TWizardState;
procedure Execute;
end;
procedure Register;
implementation
uses
Vcl.Clipbrd, System.StrUtils;
procedure Register;
begin
RegisterPackageWizard(TClipboardWizard.Create);
end;
// Formatting
function TClipboardWizard.RemoveUnneededChars(const Value: string): string;
var
List: TStringList;
q: integer;
s : string;
begin
if Trim(Value) <> '' then
begin
List := TStringList.Create;
try
List.Text := Value;
for q := 0 to List.Count - 1 do
begin
s := Trim(List[q]);
if Length(s) > 0 then
if s[1] = '''' then
s := Copy(s, 2, Length(s));
s := TrimLeft(ReverseString(s));
if Length(s) > 0 then
if s[1] = '+' then
s := TrimLeft(Copy(s, 2, Length(s)));
if Length(s) > 0 then
if s[1] = ';' then
s := TrimLeft(Copy(s, 2, Length(s)));
if Length(s) > 0 then
if s[1] = '''' then
s := TrimLeft(Copy(s, 2, Length(s)));
s := StringReplace(s, '''''', '''', [rfReplaceAll]);
List[q] := ReverseString(s)
end;
Result := List.Text;
finally
List.Free;
end;
end
else
Result := '';
end;
procedure TClipboardWizard.CopyToClipboard(Sender: TObject);
begin
with BorlandIDEServices as IOTAEditorServices do
if Assigned(TopView) then
Clipboard.AsText := RemoveUnneededChars(TopView.Block.Text);
end;
function TClipboardWizard.GetFormattedString: string;
const
FSingleQuote = '''';
Indent: array [boolean] of string = (' ', '');
EndChar: array [boolean] of string = (' +', ';');
var
List: TStringlist;
q: Integer;
begin
if Clipboard.HasFormat(CF_TEXT) then
begin
List := TStringlist.Create;
try
List.Text := Clipboard.AsText;
for q := 0 to List.Count - 1 do
List[q] := Indent[q <> 0] + AnsiQuotedStr(TrimRight(List[q]) + #32, FSingleQuote) +
EndChar[q = (List.Count - 1)];
Result := List.Text;
finally
List.Free;
end;
end;
end;
procedure TClipboardWizard.PasteFromClipboard(Sender: TObject);
begin
with BorlandIDEServices as IOTAEditorServices do
if Assigned(TopView) then
begin
TopView.Buffer.EditPosition.InsertText(GetFormattedString);
TopView.Paint; // invalidation
end;
end;
{ Anything else }
constructor TClipboardWizard.Create;
var
NTAServices : INTAServices;
begin
NTAServices := BorlandIDEServices as INTAServices;
// Main Menu
FMainMenuItem := TMenuItem.Create(nil);
FMainMenuItem.Caption := 'Clibrd Extra' ;
NTAServices.MainMenu.Items.Add(FMainMenuItem);
// Sub Menus
FCopyMenuItem := TMenuItem.Create(nil);
FCopyMenuItem.Caption := 'Copy to clipboard';
FCopyMenuItem.OnClick := Self.CopyToClipboard;
FMainMenuItem.Add(FCopyMenuItem);
FPasteMenuItem := TMenuItem.Create(nil);
FPasteMenuItem.Caption := 'Paste from clipboard';
FPasteMenuItem.OnClick := Self.PasteFromClipboard;
FMainMenuItem.Add(FPasteMenuItem);
end;
destructor TClipboardWizard.Destroy;
begin
if Assigned(FPasteMenuItem) then
FreeAndNil(FPasteMenuItem);
if Assigned(FCopyMenuItem) then
FreeAndNil(FCopyMenuItem);
if Assigned(FMainMenuItem) then
FreeAndNil(FMainMenuItem);
inherited;
end;
{ IOTANotifier }
procedure TClipboardWizard.AfterSave;
begin
end;
procedure TClipboardWizard.BeforeSave;
begin
end;
procedure TClipboardWizard.Destroyed;
begin
end;
procedure TClipboardWizard.Modified;
begin
end;
{ IOTAWizard }
function TClipboardWizard.GetIDString: string;
begin
Result := 'Clipboard.Wizard7';
end;
function TClipboardWizard.GetName: string;
begin
Result := 'Clipboard Wizard7';
end;
function TClipboardWizard.GetState: TWizardState;
begin
Result := [];
end;
procedure TClipboardWizard.Execute;
begin
end;
end.
I know the code is not perfect, but it works :-)
You could consider putting your SQL in TQuery components on Forms or Data Modules.
This solves the copy/paste problem, but it introduces others (such as the diffs between two versions of a query being worse).
You can't define a string on multiple lines without the quotes:
const
myString = 'this is a long string that extends' +
'to a second line';
Although, you can make a string out of control characters like:
const
myString = #83#84#82#73#78#71;
But that does not attribute to readble code.
In versions of Delphi >= 2007, if you are entering a quoted string over multiple lines it will automatically add a closing quote and + ' on the next line if you don't close the quote yourself.
It's not a solution to the problem but it does help speed up typing in long strings.
The short answer is no, it can't be done. (I know that is not what you want to hear.)
However Andreas Hausladen did develop an extension capable of just this. I googled for it but couldn't find it. I think it was in his DLangExtensions pack, of which he dropped support in late 2007 already. :(
I'm surprised no one's mentioned resources. Although a pain to implement the first time, once you've done it once you can implement retrieving long multiline strings from files without too much trouble. Random instructions I found here: http://www.delphibasics.info/home/delphibasicssnippets/usingresourcefileswithdelphi
With GExperts:
enable GExperts -> Editor Experts -> Paste Strings As
assign a shortcut
I am late to Party, but if GExperts i no Option:
Fast Solution: Use IDE Macro Recorder...
copy text (start recording SHIFT + STRG + R)
Press [Pos1] ['] [End] [' + sLineBreak +] [change line to one down]
(stop recording SHIFT + STRG + R)
(replay Key Strokes SHIFT + STRG + P) repeat until last line ... delete the + which is too much ...
Partially finished;
The Escaping of ' for Strings is not done this way ...