Changeset 46

Timestamp:

Dec 3, 2021, 11:47:11 AM (3 years ago)

Author:

chronos

Message:

• Fixed: Long BASE64 encoded lines were not automatically wrapped to limit max line length.
• Fixed: Missing quoted-printable encoding for saving files.

Location:

trunk

Files:

• Languages/vCardStudio.cs.po (modified) (1 diff)
• Languages/vCardStudio.po (modified) (1 diff)
• UContact.pas (modified) (3 diffs)
• UQuotedPrintable.pas (modified) (4 diffs)

trunk/Languages/vCardStudio.cs.po

@@ -12 +12 @@
 "X-Generator: Poedit 3.0\n"
 
+#: tcore.aabout.caption
+msgid "About..."
+msgstr "O aplikaci..."
+
+#: tcore.aexit.caption
+msgid "Exit"
+msgstr "Ukončit"
+
+#: tcore.afileclose.caption
+msgid "Close"
+msgstr "Zavřít"
+
+#: tcore.afilemerge.caption
+msgid "Merge..."
+msgstr "Sloučit..."
+
+#: tcore.afilenew.caption
+msgid "New"
+msgstr "Nový"
+
+#: tcore.afileopen.caption
+msgid "Open..."
+msgstr "Otevřít..."
+
+#: tcore.afileopenrecent.caption
+msgctxt "tcore.afileopenrecent.caption"
+msgid "Open recent"
+msgstr "Otevřít nedávné"
+
+#: tcore.afilesave.caption
+msgid "Save"
+msgstr "Uložit"
+
+#: tcore.afilesaveas.caption
+msgid "Save as..."
+msgstr "Uložit jako..."
+
+#: tcore.afindduplicate.caption
+msgctxt "tcore.afindduplicate.caption"
+msgid "Find duplicities"
+msgstr "Najít duplikáty"
+
+#: tcore.agenerate.caption
+msgctxt "tcore.agenerate.caption"
+msgid "Generate contacts"
+msgstr "Generovat kontakty"
+
+#: tcore.ahomepage.caption
+msgid "Home page"
+msgstr "Domovská stránka"
+
+#: tcore.applicationinfo1.description
+msgid "vCard files management tool"
+msgstr "Nástroj pro správu souborů vCard"
+
+#: tcore.asettings.caption
+msgctxt "tcore.asettings.caption"
+msgid "Settings"
+msgstr "Nastavení"
+
 #: tformcontact.aphotoload.caption
 msgid "Load from file"

trunk/Languages/vCardStudio.po

@@ -1 +1 @@
 msgid ""
 msgstr "Content-Type: text/plain; charset=UTF-8"
+
+#: tcore.aabout.caption
+msgid "About..."
+msgstr ""
+
+#: tcore.aexit.caption
+msgid "Exit"
+msgstr ""
+
+#: tcore.afileclose.caption
+msgid "Close"
+msgstr ""
+
+#: tcore.afilemerge.caption
+msgid "Merge..."
+msgstr ""
+
+#: tcore.afilenew.caption
+msgid "New"
+msgstr ""
+
+#: tcore.afileopen.caption
+msgid "Open..."
+msgstr ""
+
+#: tcore.afileopenrecent.caption
+msgctxt "tcore.afileopenrecent.caption"
+msgid "Open recent"
+msgstr ""
+
+#: tcore.afilesave.caption
+msgid "Save"
+msgstr ""
+
+#: tcore.afilesaveas.caption
+msgid "Save as..."
+msgstr ""
+
+#: tcore.afindduplicate.caption
+msgctxt "tcore.afindduplicate.caption"
+msgid "Find duplicities"
+msgstr ""
+
+#: tcore.agenerate.caption
+msgctxt "tcore.agenerate.caption"
+msgid "Generate contacts"
+msgstr ""
+
+#: tcore.ahomepage.caption
+msgid "Home page"
+msgstr ""
+
+#: tcore.applicationinfo1.description
+msgid "vCard files management tool"
+msgstr ""
+
+#: tcore.asettings.caption
+msgctxt "tcore.asettings.caption"
+msgid "Settings"
+msgstr ""
 
 #: tformcontact.aphotoload.caption

trunk/UContact.pas

@@ -691 +691 @@
   NameText: string;
   Value2: string;
+  Text: string;
+  LineIndex: Integer;
+  OutText: string;
+  LinePrefix: string;
+const
+  MaxLineLength = 73;
 begin
   inherited;
@@ -705 +711 @@
         if Encoding <> '' then begin
           Value2 := GetEncodedValue;
-          NameText := NameText + ';' + Encoding;
+          NameText := NameText + ';ENCODING=' + Encoding;
         end else Value2 := Value;
         if Pos(LineEnding, Value2) > 0 then begin
@@ -715 +721 @@
           Add('');
         end else begin
-          Add(NameText + ':' + Value2);
+          OutText := NameText + ':' + Value2;
+          LineIndex := 0;
+          LinePrefix := '';
+          while True do begin
+            if Length(OutText) > MaxLineLength then begin
+              if (LineIndex > 0) and (LinePrefix = '') then LinePrefix := ' ';
+              Add(LinePrefix + Copy(OutText, 1, MaxLineLength));
+              System.Delete(OutText, 1, MaxLineLength);
+              Inc(LineIndex);
+              Continue;
+            end else begin
+              Add(LinePrefix + OutText);
+              Break;
+            end;
+          end;
+          if LinePrefix <> '' then Add('');
         end;
       end;

trunk/UQuotedPrintable.pas

@@ -29 +29 @@
   Keeper: Boolean;
   Abort: Boolean;
-  BufStream: TMemoryStream;
+  InStream: TMemoryStream;
   OutStream: TMemoryStream;
 begin
   Result := '';
-  BufStream := TMemoryStream.Create;
+  InStream := TMemoryStream.Create;
   OutStream := TMemoryStream.Create;
   try
   if Text <> '' then begin
-    BufStream.Write(Text[1], Length(Text));
-    BufStream.Position := 0;
+    InStream.Write(Text[1], Length(Text));
+    InStream.Position := 0;
   end;
   Abort := False;
@@ -48 +48 @@
   { Skip any CR/LF's to get to the encoded stuff }
   while True do begin
-    if BufStream.Read(Char(InBuf[0]), 1) = 0then
+    if InStream.Read(Char(InBuf[0]), 1) = 0then
       Exit;
     if ((InBuf[0] <> $0D) and (InBuf[0] <> $0A)) then begin
@@ -70 +70 @@
       if (I > High(InBuf)) then
         raise Exception.Create(SLineLengthErr);
-      if BufStream.Read(Char(InBuf[I]), 1) = 0 then
+      if InStream.Read(Char(InBuf[I]), 1) = 0 then
         Break;
       case InBuf[I] of
@@ -195 +195 @@
   SetLength(Result, OutStream.Size);
   OutStream.Position := 0;
-  OutStream.Read(Result[1], Length(Result));
+  if OutStream.Size > 0 then
+    OutStream.Read(Result[1], Length(Result));
   finally
     OutStream.Free;
-    BufStream.Free;
+    InStream.Free;
   end;
 end;
 
 function EncodeQuotedPrintable(Text: string): string;
+var
+  O, W: Integer;
+  WordBuf, OutBuf: array[0..80] of AnsiChar;
+  CurChar: AnsiChar;
+  Abort: Boolean;
+  InStream: TStream;
+  OutStream: TMemoryStream;
+
+  procedure SendLine;
+  begin
+    if (OutBuf[O - 1] = #9) or (OutBuf[O - 1] = #32) then begin
+      OutBuf[O] := '=';
+      Inc(O);
+    end;
+    OutStream.Write(OutBuf, O);
+    FillChar(OutBuf, SizeOf(OutBuf), #0);
+    O := 0;
+  end;
+
+  procedure AddWordToOutBuf;
+  var
+    J : Integer;
+  begin
+    if (O + W) > 74 then SendLine;
+    for J := 0 to (W - 1) do begin
+      OutBuf[O] := WordBuf[J];
+      Inc(O);
+    end;
+    W := 0;
+  end;
+
+  procedure AddHexToWord(B : Byte);
+  const
+    HexDigits : array[0..$F] of AnsiChar = '0123456789ABCDEF';
+  begin
+    if W > 73 then AddWordToOutBuf;
+    WordBuf[W] := '=';
+    WordBuf[W + 1] := HexDigits[B shr 4];
+    WordBuf[W + 2] := HexDigits[B and $F];
+    Inc(W, 3)
+  end;
+
 begin
-  Result := Text;
+  Result := '';
+  InStream := TMemoryStream.Create;
+  OutStream := TMemoryStream.Create;
+  try
+    if Text <> '' then begin
+      InStream.Write(Text[1], Length(Text));
+      InStream.Position := 0;
+    end;
+
+    Abort := False;
+    O := 0;
+    W := 0;
+    FillChar(OutBuf, SizeOf(OutBuf), #0);
+    while (InStream.Read(CurChar, 1) = 1) and not Abort do begin
+      if (Ord(CurChar) in [33..60, 62..126]) then begin
+        WordBuf[W] := CurChar;
+        Inc(W);
+        if W > 74 then AddWordToOutBuf;
+      end else if (CurChar = ' ') or (CurChar = #9) then begin
+        WordBuf[W] := CurChar;
+        Inc(W);
+        AddWordToOutBuf;
+      end else if (CurChar = #13) then begin
+        AddWordToOutBuf;
+        SendLine;
+      end else if (CurChar = #10) then begin
+        { Do nothing }
+      end else begin
+        AddHexToWord(Byte(CurChar));
+      end;
+    end;
+    AddWordToOutBuf;
+    OutStream.Write(OutBuf, O);
+    SetLength(Result, OutStream.Size);
+    OutStream.Position := 0;
+    if OutStream.Size > 0 then
+      OutStream.Read(Result[1], Length(Result));
+  finally
+    OutStream.Free;
+    InStream.Free;
+  end;
 end;