I am using Mailkit GetSubfolders method which emits this Request/Response to the server
C: A00000005 LIST "" "INBOX.%" RETURN (SUBSCRIBED CHILDREN STATUS (UIDVALIDITY))
S: * LIST (\HasNoChildren \UnMarked) "." INBOX.kkkk
S: * STATUS INBOX.kkkk (UIDVALIDITY 1491227899)
S: * LIST (\HasChildren \UnMarked) "." INBOX.Archive
S: * LIST (\HasChildren \UnMarked) "." INBOX.spam
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Sent
S: * STATUS INBOX.Sent (UIDVALIDITY 1491227490)
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Junk
S: * STATUS INBOX.Junk (UIDVALIDITY 1491227488)
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Drafts
S: * STATUS INBOX.Drafts (UIDVALIDITY 1491227487)
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Trash
S: * STATUS INBOX.Trash (UIDVALIDITY 1491227603)
S: A00000005 OK List completed (0.001 + 0.000 secs).
However I noticed Outlook and other mail client shows more folders for my account that I am getting with MailKit GetSubfolders. In particular INBOX.INBOX.dfgdfg folder. I executed LIST "" "INBOX.*" (changing % to *) and I see this time the server returns the missing folder (see below). My question is how to get to INBOX.INBOX.dfgdfg folder using MailKit methods?
C: A00000005 LIST "" "INBOX.*" RETURN (SUBSCRIBED CHILDREN STATUS (UIDVALIDITY))
S: * LIST (\HasNoChildren \UnMarked) "." INBOX.kkkk
S: * STATUS INBOX.kkkk (UIDVALIDITY 1491227899)
S: * LIST (\HasChildren \UnMarked) "." INBOX.Archive
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Archive.000
S: * STATUS INBOX.Archive.000 (UIDVALIDITY 1491227889)
S: * LIST (\HasNoChildren \UnMarked) "." INBOX.Archive.aaaaa
S: * STATUS INBOX.Archive.aaaaa (UIDVALIDITY 1491227877)
S: * LIST (\HasChildren \UnMarked) "." INBOX.spam
S: * LIST (\HasNoChildren \UnMarked) "." INBOX.spam.666
S: * STATUS INBOX.spam.666 (UIDVALIDITY 1491227878)
S: * LIST (\HasNoChildren \UnMarked) "." INBOX.spam.nnhnhn
S: * STATUS INBOX.spam.nnhnhn (UIDVALIDITY 1491227870)
S: * LIST (\HasNoChildren \UnMarked) "." INBOX.spam.test
S: * STATUS INBOX.spam.test (UIDVALIDITY 1491227856)
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Sent
S: * STATUS INBOX.Sent (UIDVALIDITY 1491227490)
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Junk
S: * STATUS INBOX.Junk (UIDVALIDITY 1491227488)
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Drafts
S: * STATUS INBOX.Drafts (UIDVALIDITY 1491227487)
S: * LIST (\Subscribed \HasNoChildren \UnMarked) "." INBOX.Trash
S: * STATUS INBOX.Trash (UIDVALIDITY 1491227603)
S: * LIST (\HasNoChildren \UnMarked) "." INBOX.INBOX.dfgdfg
S: * STATUS INBOX.INBOX.dfgdfg (UIDVALIDITY 1491227900)
S: A00000005 OK List completed (0.001 + 0.000 secs).
I was able to answer my question. ImapClient.GetFolders is returning all the folders in the namespace including the missing INBOX.INBOX.dfgdfg
You are meant to call GetSubfolders() on each folder returned by GetSubfolders() if you want to recurse.
The problem with using * is that on some IMAP servers (cough UW.IMAPd cough), if the user has symlinks, the server response will never end because it does not properly detect symlink recursion.
Related
I have the following code for creating superscript versions of the digits '0' to '9' and the signs '+' and '-'
const
Digits = ['0' .. '9'];
Signs = ['+', '-'];
DigitsAndSigns = Digits + Signs;
function SuperScript(c: Char): Char;
{ Returns the superscript version of the character c
Only for the numbers 0..9 and the signs +, - }
const
SuperDigits: array ['0' .. '9'] of Char = ('⁰', '¹', '²', '³', '⁴', '⁵', '⁶', '⁷', '⁸', '⁹');
begin
if CharInSet(c, Digits) then
Result := SuperDigits[c]
else if c = '+' then
Result := '⁺'
else if c = '-' then
Result := '⁻'
else
Result := c;
end;
This works, but is not very elegant. Ideally I would like to have something like
SuperDigits: array [DigitsAndSigns] of Char = ('⁰', '¹', '²', '³', '⁴', '⁵', '⁶', '⁷', '⁸', '⁹', '⁺', '⁻');
but this does not even compile.
Is it somehow possible to create and preset an array element for every element in the set?
I am aware that I could use more heavy components like TDictionary, but (if possible) I would like to use sets or enumerations.
Actually there is a solution to achieve what you want, but perhaps not what you expected:
type
SuperDigit = record
private
class function GetItem(const C: Char): Char; static;
public
class property Item[const C: Char]: Char read GetItem; default;
end;
class function SuperDigit.GetItem(const C: Char): Char;
const
cDigitsAndSigns = '0123456789+-';
cSuperScripts = '⁰¹²³⁴⁵⁶⁷⁸⁹⁺⁻';
begin
Result := C;
var idx := Pos(C, cDigitsAndSigns);
if idx >= 0 then
Result := cSuperScripts[idx];
end;
With this declaration your can write something like this:
procedure ToSuperScript(var S: string);
begin
for var I := 1 to Length(S) do
S[I] := SuperDigit[S[I]];
end;
Is it somehow possible to create and preset an array element for every element in the set?
No.
This is fundamentally impossible because the set is an unordered container.
In your case, Digits + Signs is exactly the same thing as Signs + Digits, so how could you possibly know in what order to enumerate the elements?
Also, it might be worth pointing out that the brackets in
const
Digits = ['0' .. '9'];
are not of the same kind as the brackets in
array ['0' .. '9'] of Char
The brackets in Digits really do make a set, but the static array syntax has nothing to do with sets. A static array is indexed by an ordinal type.
In theory, you could create an enumerated type with your characters, but then you need to convert an input character to your enumerated type, and then back to the mapped character. So this is not convenient.
In your particular case, you have a mapping Char → Char. The underlying Unicode code points aren't really nice enough to facilitate any clever tricks (like you can do with ASCII lower case -> upper case, for example). In fact, the superscript digits are not even contiguous! So you have no choice but to do a plain, data-based mapping of some sort.
I'd just use a case construct like in UnicodeSuperscript here:
function UnicodeSuperscript(const C: Char): Char;
begin
case C of
'0':
Result := '⁰';
'1':
Result := '¹';
'2':
Result := '²';
'3':
Result := '³';
'4':
Result := '⁴';
'5':
Result := '⁵';
'6':
Result := '⁶';
'7':
Result := '⁷';
'8':
Result := '⁸';
'9':
Result := '⁹';
'+':
Result := '⁺';
'-', '−':
Result := '⁻';
else
Result := C;
end;
end;
In terms of elegance, I guess you may want to separate data from logic. One (overkill and slower!) approach would be to store a constant array like in
function UnicodeSuperscript(const C: Char): Char;
const
Chars: array[0..12] of
record
B,
S: Char
end
=
(
(B: '0'; S: '⁰'),
(B: '1'; S: '¹'),
(B: '2'; S: '²'),
(B: '3'; S: '³'),
(B: '4'; S: '⁴'),
(B: '5'; S: '⁵'),
(B: '6'; S: '⁶'),
(B: '7'; S: '⁷'),
(B: '8'; S: '⁸'),
(B: '9'; S: '⁹'),
(B: '+'; S: '⁺'),
(B: '-'; S: '⁻'),
(B: '−'; S: '⁻')
);
begin
for var X in Chars do
if C = X.B then
Exit(X.S);
Result := C;
end;
A project uses OverByteICS components, in RadStudio XE8 Delphi, and... when I create a TX509 Component for access a P12 certificate, and load from file, the TX509Base.OpenFileBio function in OberbyteIcsWSocket unit raises "\r\nError on opening file "C:\Files\certif\clientkstore.p12"\r\nerror:02001005:system library:fopen:Input/output error\r\nerror:2006D002:BIO routines:BIO_new_file:system lib\r\n" exception message...
The server where app runs hasn't openSSl installed. But that is the idea, to use this component for not install openSSL....
The libeay32.dll and ssleay32.dll are in same folder as the app.
What could be happening?
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
function TX509Base.OpenFileBio(
const FileName : String;
Methode : TBioOpenMethode): PBIO;
begin
if (Filename = '') then
raise EX509Exception.Create('File name not specified');
if (Methode = bomRead) and (not FileExists(Filename)) then
raise EX509Exception.Create('File not found "' +
Filename + '"');
if Methode = bomRead then
Result := f_BIO_new_file(PAnsiChar(AnsiString(Filename)), PAnsiChar('r+')) **{<---here raises}**
else
Result := f_BIO_new_file(PAnsiChar(AnsiString(Filename)), PAnsiChar('w+'));
if (Result = nil) then
RaiseLastOpenSslError(EX509Exception, TRUE,
'Error on opening file "' + Filename + '"');
end;
and its caller
procedure TPKCS12Certificate.LoadFromP12File(const FileName: String;
IncludePrivateKey: Boolean; const Password: String);
var
FileBio : PBIO;
X : PPKCS12;//PX509;
Y : PX509;
PKey : PEVP_PKEY;
ca: PSTACK;
begin
InitializeSsl;
FileBio := OpenFileBio(FileName, bomRead); {<-- Here raises}
try
if not Assigned(FileBio) then
raise EX509Exception.Create('BIO not assigned');
X := f_d2i_PKCS12_bio(FileBio, nil);
if not Assigned(X) then
RaiseLastOpenSslError(EX509Exception, TRUE,
'Error reading certificate from BIO PKC512');
try
if IncludePrivateKey then begin
f_BIO_ctrl(FileBio, BIO_CTRL_RESET, 0, nil);
PKey := f_PEM_read_bio_PrivateKey(FileBio, nil, nil,
PAnsiChar(AnsiString(Password)));
if not Assigned(PKey) then
RaiseLastOpenSslError(EX509Exception, TRUE,
'Error reading private key from BIO');
try
X509 := X;
PrivateKey := PKey;
finally
f_EVP_PKEY_free(PKey);
end;
end else
P12 := X;
X509 := Y;
finally
f_PKCS12_free(X);
end;
finally
f_bio_free(FileBio);
end;
end;
Solved with last version of ICS Components
I have a program that writes to a log file and zips it. I want to set it up so that it will take the log file and zip it after a month and clear the file and reset it to do it again if another month has passed
procedure SendToLog(Const MType : twcMTypes; Const callProgram, callPas, callProssecs, EMessage, zipName : String; AddlStr : String = '' );
Const
MTValues = 'EDS';
var
LogFile : TextFile;
LogName : String;
EString : String;
begin
logName := WebLogPath; // þ for delimeter
EString := MTValues[ Ord( MType )+1] + PC + FormatDateTime( 'mm/dd/yyyy hh:nn:ss.zzz', Now )
+ PC + callProgram + PC + callpas + PC + callProssecs + PC + EMessage;
Assign( LogFile, LogName );
if FileExists(LogName) then
Append( LogFile ) { Open to Append }
else
begin
Rewrite( LogFile ); { Create file }
end;
Writeln( LogFile, EString );
Close( LogFile );
ArchiveFiles('C:', 'mytest.log', 'C:', zipName + '.zip', 'M');
I want to know how I make so that every time the program logs something it checks if the a month has passed then it will zip everything into a new file and reset the log.
You would have to either:
keep track of the last write date somewhere, persistently across app restarts.
query the last write date of the log file itself using the Win32 API GetFileTime() function.
put the current date on each log entry that you write, then you can seek to the end of the log file and read the date from the last log entry that was written.
Each time you want to write a new log entry, compare the month+year of the last known date against the current date and then zip+reset the log file if the current date is higher.
http://docwiki.embarcadero.com/Libraries/XE2/en/System.IOUtils.TFile.GetCreationTime
http://docwiki.embarcadero.com/Libraries/XE2/en/System.IOUtils.TFile.AppendAllText
http://docwiki.embarcadero.com/Libraries/XE2/en/System.IOUtils.TFile.Exists
So you just check for creation date and then you decide if you need a new file or not.
procedure SendToLog(Const MType : twcMTypes; Const callProgram, callPas, callProssecs, EMessage, zipName : String; AddlStr : String = '' );
Const
MTValues = 'EDS';
MaxAgeBeforeNewLogFile = 30; // 30 days, in TDateTime type convention
var
LogFile : TextFile;
LogName : String;
EString : String;
NeedZipLogFile : Boolean; ZipName: String;
begin
logName := WebLogPath; // þ for delimeter
EString := MTValues[ Ord( MType )+1] + PC + FormatDateTime( 'mm/dd/yyyy hh:nn:ss.zzz', Now )
+ PC + callProgram + PC + callpas + PC + callProssecs + PC + EMessage;
NeedZipLogFile := False;
if System.IOUtils.TFile.Exists( LogName ) then
NeedZipLogFile := Now() - System.IOUtils.TFile.GetCreationTime( LogName )
> MaxAgeBeforeNewLogFile;
if NeedZipLogFile then begin
ZipName := _Generate_New_Non_Used_And_Proper_Name_For_Archive();
_Save_Log_Into_Zip( LogName );
If _Secure_Keeping_Of_Logs_Is_Very_Very_Important then begin
_Flush_Windows_File_Cache_To_Disk( ZipName );
_Read_Zipped_Log_Into_Memory( ZipName, ExtractFileName( LogName ), _Temp_Memory_Buffer );
_Compare_With_Old_Log_File_And_Ensure_Nothing_Was_Lost( LogName, _Temp_Memory_Buffer);
end;
DeleteFile( LogFile);
end;
System.IOUtils.TFile.AppendAllText( LogFile, EString );
end;
I use C# basically. There I can do:
string trimmed = str.Trim('\t');
to trim tabulation from the string str and return the result to trimmed.
In delphi7 I found only Trim, that trims spaces.
How can I achieve the same functionality?
There is string helper TStringHelper.Trim that accepts array of Char as optional parameter.
function Trim(const TrimChars: array of Char): string; overload;
So, you can use
trimmed := str.Trim([#09]);
for your example. #09 here is ASCII code for Tab character.
This function exists since at least Delphi XE3.
Hope it helps.
This is a kind of procedure sometimes easier to create than to find where it lives :)
function TrimChar(const Str: string; Ch: Char): string;
var
S, E: integer;
begin
S:=1;
while (S <= Length(Str)) and (Str[S]=Ch) do Inc(S);
E:=Length(Str);
while (E >= 1) and (Str[E]=Ch) do Dec(E);
SetString(Result, PChar(#Str[S]), E - S + 1);
end;
In Delphi the Trim function does not take parameters but it does trim other characters as well as spaces. Here's the code (from System.SysUtils in XE2, I don't think it has changed):
function Trim(const S: string): string;
var
I, L: Integer;
begin
L := Length(S);
I := 1;
if (L > 0) and (S[I] > ' ') and (S[L] > ' ') then Exit(S);
while (I <= L) and (S[I] <= ' ') do Inc(I);
if I > L then Exit('');
while S[L] <= ' ' do Dec(L);
Result := Copy(S, I, L - I + 1);
end;
It is trimming anything less than ' ' which would eliminate any control characters like tab, carriage return and line feed.
Delphi doesn't provide a function that does what you want. The built-in Trim function always trims the same set of characters (whitespace and control characters) from both ends of the input string. Several answers here show the basic technique for trimming arbitrary characters. As you can see, it doesn't have to be complicated. Here's my version:
function Trim(const s: string; c: Char): string;
var
First, Last: Integer;
begin
First := 1;
Last := Length(s);
while (First <= Last) and (s[First] = c) do
Inc(First);
while (First < Last) and (s[Last] = c) do
Dec(last);
Result := Copy(s, First, Last - First + 1);
end;
To adapt that for trimming multiple characters, all you have to do is change the second conditional term in each loop. What you change it to depends on how you choose to represent the multiple characters. C# uses an array. You could also put all the characters in a string, or you could use Delphi's native set type.
function Trim(const s: string; const c: array of Char): string;
// Replace `s[x] = c` with `CharInArray(s[x], c)`.
function Trim(const s: string; const c: string): string;
// Replace `s[x] = c` with `CharInString(s[x], s)`.
function Trim(const s: string; const c: TSysCharSet): string;
// Replace `s[x] = c` with `s[x] in c`.
The CharInArray and CharInString functions are easy to write:
function CharInArray(c: Char; ar: array of Char): Boolean;
var
i: Integer;
begin
Result := True;
for i := Low(ar) to High(ar) do
if ar[i] = c then
exit;
Result := False;
end;
// CharInString is identical, except for the type of `ar`.
Recall that as of Delphi 2009, Char is an alias for WideChar, meaning it's too big to fit in a set, so you wouldn't be able to use the set version unless you were guaranteed the input would always fit in an AnsiChar. Furthermore, the s[x] in c syntax generates warnings on WideChar arguments, so you'd want to use CharInSet(s[x], c) instead. (Unlike CharInArray and CharInString, the RTL provides CharInSet already, for Delphi versions that need it.)
You can use StringReplace:
var
str:String;
begin
str:='The_aLiEn'+Chr(VK_TAB)+'Delphi';
ShowMessage(str);
str:=StringReplace(str, chr(VK_Tab), '', [rfReplaceAll]);
ShowMessage(str);
end;
This omits all Tab characters from given string. But you can improve it, if you want leading and trailing tabs to be removed then you can use Pos function also.
Edit:
For the comment asking how to do it with Pos, here it is:
var
str:String;
s, e: PChar;
begin
str:=Chr(VK_TAB)+Chr(VK_TAB)+'The_aLiEn'+Chr(VK_TAB)+'Delphi'+Chr(VK_TAB)+Chr(VK_TAB);
s:=PChar(str);
while Pos(Chr(VK_TAB), s)=1 do inc(s);
e:=s;
inc(e, length(s)-1);
while Pos(Chr(VK_TAB), e)=1 do dec(e);
str:=Copy(s, 1, length(s)-length(e)+1);
ShowMessage(str);
end;
It is of course the same approach by Maksee's and a bit more job to do as it is. But if there isn't much time to finish the work and if Pos is what you've thought first, then this is how it can be done. You, the programmer should and have to think about optimizations, not me. And if we're talking constraints of optimization, with a little tweak to replace Pos with char compare, this will run faster than Maksee's code.
Edit for Substr search generalization:
function TrimStr(const Source, SubStr: String): String;
var
s, e: PChar;
l: Integer;
begin
s:=PChar(Source);
l:=Length(SubStr);
while Pos(SubStr, s)=1 do inc(s, l);
e:=s;
inc(e, length(s)-l);
while Pos(SubStr, e)=1 do dec(e, l);
Result:=Copy(s, 1, length(s)-length(e)+l);
end;
The JEDI JCL v2.7 provides these useful functions for what you need:
function StrTrimCharLeft(const S: string; C: Char): string;
function StrTrimCharsLeft(const S: string; const Chars: TCharValidator): string; overload;
function StrTrimCharsLeft(const S: string; const Chars: array of Char): string; overload;
function StrTrimCharRight(const S: string; C: Char): string;
function StrTrimCharsRight(const S: string; const Chars: TCharValidator): string; overload;
function StrTrimCharsRight(const S: string; const Chars: array of Char): string; overload;
function StrTrimQuotes(const S: string): string;
Delphi Xe, Win7x64
To request a string resource with known number:
Function GuGetStrRes(Fn:string;Nom:integer):string;
var
h:THandle;
buffer:array [0..255] of Char;
begin
Result:='';
if fileexists(Fn)=false then
exit;
Try
h:=LoadLibraryEx(pchar(Fn),0,LOAD_LIBRARY_AS_DATAFILE);
if h=0 then
exit;
if LoadString(h, Nom, buffer, SizeOf(buffer)) > 0 then
Result:=string(buffer);
FreeLibrary(h);
Except
Try
if h<>0 then
FreeLibrary(h);
except
end;
End;
End;
// Use
Showmessage(GuGetStrRes('c:\windows\system32\shell32.dll',4200));
Question: how to learn ALL numbers of 'string' resources in DLL? For example to receive a array: 11,22,23,24,40000 and so on (they can go not one after another)
Tried so:
...
var
dllname, str:string;
begin
dllname: ='c:\windows\system32\shell32.dll';
str: = ";
For i: = 0 to 10000 do
begin
str: = GuGetStrRes (dllname, i);
if str <> " then
memo1.lines.add (inttostr (i) + ' - ' +str);
end;
end;
But for some reason it causes an error (even the design try-except does not help), when i: = 4201 :(
When i=0..4200 and >4210, all is OK.
To enumerate the resources strings you must use the EnumResourceNames function passing the RT_STRING type.
check this sample.
{$APPTYPE CONSOLE}
uses
Classes,
Windows,
SysUtils;
function EnumResNameProc(hModule : THandle; lpszType, lpszName : PChar; lParam : longint) : boolean; stdcall;
var
Id : LongInt;
Min : Integer;
Max : Integer;
Index : Integer;
Buffer : PWChar;
Stream : TResourceStream;
Len : Word;
begin
if Longint(lpszName)<65535 then
begin
Id:= longint(lpszName);
Writeln(Format('RT_STRING ID %d',[Id]));
Min:=(Id - 1) * 16;
Max:=(Id * 16) - 1;
Stream:=TResourceStream.CreateFromID(hModule,Id,RT_STRING);
try
Buffer:=Stream.Memory;
for Index:=Min to Max do
begin
//determine the length of the string
Len:=Word(Buffer^);
if Len>0 then
begin
Writeln(Format(' String ID %d',[Index]));
Inc(Buffer,Len+1);
end
else
Inc(Buffer);
end;
finally
Stream.Free;
end;
end
else
Writeln(string(lpszName));
Result := true;
end;
procedure EnumerateStringResources(const FileName:string);
var
hModule : Thandle;
restype : byte;
begin
hModule := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
if hModule=0 then exit
else
try
EnumResourceNames(hModule, RT_STRING, #EnumResNameProc, 0);
finally
FreeLibrary(hModule);
end;
end;
begin
try
EnumerateStringResources('YourApplication.exe');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
readln;
end.
and the output depending of your resources will be somehitng like this
RT_STRING ID 4080
String ID 65264
String ID 65265
String ID 65266
String ID 65267
String ID 65268
String ID 65269
String ID 65270
String ID 65271
String ID 65272
String ID 65273
String ID 65274
String ID 65275
String ID 65276
String ID 65277
String ID 65278
String ID 65279
RT_STRING ID 4081
String ID 65280
String ID 65281
String ID 65282
String ID 65283
String ID 65284
String ID 65285
String ID 65286
String ID 65287
String ID 65288
String ID 65289
String ID 65290
String ID 65291
String ID 65292
String ID 65293
String ID 65294
String ID 65295
UPDATE
I updated the answer to reflect the strings id inside of the string table, the strings are grouped together in bundles of 16. So the first bundle contains strings 0 through 15, the second bundle contains strings 16 through 31, and so on. so the formula to calculate the strings id can be determined in this way
Min:=(Id - 1) * 16;
Max:=(Id * 16) - 1;
for more information you can read this article from Raymond Chen The format of string resources