sync: restore source from Google Drive
Sync changed files to Google Drive / sync (push) Successful in 1h45m13s
Sync changed files to Google Drive / sync (push) Successful in 1h45m13s
This commit is contained in:
admin_d committed
1 parent
e2d8247e91
commit
7063d1b1c9
993 files changed
+949976
No files matched your search
@@ -0,0 +1,416 @@
|
||||
// SPDX-License-Identifier: LGPL-3.0-linking-exception
|
||||
unit BGRALazResource;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
BGRAClasses, SysUtils, BGRAMultiFileType;
|
||||
|
||||
type
|
||||
{ TLazResourceEntry }
|
||||
|
||||
TLazResourceEntry = class(TMultiFileEntry)
|
||||
private
|
||||
procedure Serialize(ADestination: TStream);
|
||||
protected
|
||||
FName: utf8string;
|
||||
FValueType: utf8string;
|
||||
FContent: TStream;
|
||||
function GetName: utf8string; override;
|
||||
procedure SetName(AValue: utf8string); override;
|
||||
function GetExtension: utf8string; override;
|
||||
function GetFileSize: int64; override;
|
||||
public
|
||||
constructor Create(AContainer: TMultiFileContainer; AName: utf8string; AValueType: utf8string; AContent: TStream);
|
||||
destructor Destroy; override;
|
||||
function CopyTo(ADestination: TStream): int64; override;
|
||||
function GetStream: TStream; override;
|
||||
end;
|
||||
|
||||
{ TFormDataEntry }
|
||||
|
||||
TFormDataEntry = class(TLazResourceEntry)
|
||||
protected
|
||||
FTextContent: TStream;
|
||||
procedure RequireTextContent;
|
||||
function GetExtension: utf8string; override;
|
||||
function GetFileSize: int64; override;
|
||||
public
|
||||
constructor Create(AContainer: TMultiFileContainer; AName: utf8string; ABinaryContent: TStream);
|
||||
destructor Destroy; override;
|
||||
function CopyTo(ADestination: TStream): int64; override;
|
||||
end;
|
||||
|
||||
{ TLazResourceContainer }
|
||||
|
||||
TLazResourceContainer = class(TMultiFileContainer)
|
||||
protected
|
||||
function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override;
|
||||
public
|
||||
procedure LoadFromStream(AStream: TStream); override;
|
||||
procedure SaveToStream(ADestination: TStream); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses LResources, BGRAUTF8;
|
||||
|
||||
{ TFormDataEntry }
|
||||
|
||||
procedure TFormDataEntry.RequireTextContent;
|
||||
begin
|
||||
if FTextContent = nil then
|
||||
begin
|
||||
FTextContent:= TMemoryStream.Create;
|
||||
FContent.Position:= 0;
|
||||
LRSObjectBinaryToText(FContent, FTextContent);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFormDataEntry.GetExtension: utf8string;
|
||||
begin
|
||||
Result:= 'lfm';
|
||||
end;
|
||||
|
||||
function TFormDataEntry.GetFileSize: int64;
|
||||
begin
|
||||
RequireTextContent;
|
||||
Result:= FTextContent.Size;
|
||||
end;
|
||||
|
||||
constructor TFormDataEntry.Create(AContainer: TMultiFileContainer;
|
||||
AName: utf8string; ABinaryContent: TStream);
|
||||
begin
|
||||
inherited Create(AContainer,AName,'FORMDATA',ABinaryContent);
|
||||
end;
|
||||
|
||||
destructor TFormDataEntry.Destroy;
|
||||
begin
|
||||
FreeAndNil(FTextContent);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TFormDataEntry.CopyTo(ADestination: TStream): int64;
|
||||
begin
|
||||
RequireTextContent;
|
||||
if FTextContent.Size = 0 then
|
||||
result := 0
|
||||
else
|
||||
begin
|
||||
FTextContent.Position:= 0;
|
||||
result := ADestination.CopyFrom(FTextContent,FTextContent.Size);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TLazResourceEntry }
|
||||
|
||||
procedure TLazResourceEntry.Serialize(ADestination: TStream);
|
||||
begin
|
||||
FContent.Position := 0;
|
||||
BinaryToLazarusResourceCode(FContent, ADestination, Name, FValueType);
|
||||
end;
|
||||
|
||||
function TLazResourceEntry.GetName: utf8string;
|
||||
begin
|
||||
Result:= FName;
|
||||
end;
|
||||
|
||||
procedure TLazResourceEntry.SetName(AValue: utf8string);
|
||||
begin
|
||||
if AValue = FName then exit;
|
||||
if Container.IndexOf(AVAlue, Extension) <> -1 then
|
||||
raise Exception.Create('Name is already used for this extension');
|
||||
FName := AValue;
|
||||
end;
|
||||
|
||||
function TLazResourceEntry.GetExtension: utf8string;
|
||||
begin
|
||||
Result:= FValueType;
|
||||
end;
|
||||
|
||||
function TLazResourceEntry.GetFileSize: int64;
|
||||
begin
|
||||
Result:= FContent.Size;
|
||||
end;
|
||||
|
||||
destructor TLazResourceEntry.Destroy;
|
||||
begin
|
||||
FreeAndNil(FContent);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
constructor TLazResourceEntry.Create(AContainer: TMultiFileContainer; AName: utf8string; AValueType: utf8string;
|
||||
AContent: TStream);
|
||||
begin
|
||||
inherited Create(AContainer);
|
||||
FName := AName;
|
||||
FValueType := UTF8UpperCase(AValueType);
|
||||
FContent := AContent;
|
||||
end;
|
||||
|
||||
function TLazResourceEntry.CopyTo(ADestination: TStream): int64;
|
||||
begin
|
||||
if FContent.Size = 0 then
|
||||
result := 0
|
||||
else
|
||||
begin
|
||||
FContent.Position:= 0;
|
||||
result := ADestination.CopyFrom(FContent, FContent.Size);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazResourceEntry.GetStream: TStream;
|
||||
begin
|
||||
Result:= FContent;
|
||||
end;
|
||||
|
||||
{ TLazResourceContainer }
|
||||
|
||||
procedure TLazResourceContainer.LoadFromStream(AStream: TStream);
|
||||
const
|
||||
entryStart = 'LazarusResources.Add(';
|
||||
entryEnd = ');';
|
||||
whiteSpace = [' ',#9,#10,#13,#26];
|
||||
var
|
||||
fileContent: String;
|
||||
filePos : integer;
|
||||
|
||||
procedure SkipWhitespace;
|
||||
begin
|
||||
while (filePos <= length(fileContent)) and (fileContent[filePos] in whiteSpace) do inc(filePos);
|
||||
end;
|
||||
|
||||
procedure SkipComma;
|
||||
begin
|
||||
SkipWhitespace;
|
||||
if (filePos <= length(fileContent)) and (fileContent[filePos] = ',') then
|
||||
inc(filePos)
|
||||
else
|
||||
raise Exception.Create('Comma expected');
|
||||
end;
|
||||
|
||||
function ParseString(ignoreCommas: boolean): TStream;
|
||||
var
|
||||
expectPlus: boolean;
|
||||
|
||||
procedure AppendChar(c: char);
|
||||
begin
|
||||
result.WriteByte(ord(c));
|
||||
end;
|
||||
|
||||
function ParseNumber: integer;
|
||||
var numberStart, errPos: integer;
|
||||
s: String;
|
||||
begin
|
||||
numberStart:= filePos;
|
||||
if (filePos <= length(fileContent)) and (fileContent[filePos] = '$') then
|
||||
begin
|
||||
inc(filePos);
|
||||
while (filePos <= length(fileContent)) and (fileContent[filePos] in['0'..'9','a'..'f','A'..'F']) do inc(filePos);
|
||||
end else
|
||||
begin
|
||||
while (filePos <= length(fileContent)) and (fileContent[filePos] in['0'..'9']) do inc(filePos);
|
||||
end;
|
||||
s := copy(fileContent,numberStart,filePos-numberStart);
|
||||
val(s, result, errPos);
|
||||
if errPos <> 0 then
|
||||
raise exception.Create('Invalid number "' + s + '"');
|
||||
end;
|
||||
|
||||
function ParseStringPart: boolean;
|
||||
var charCode: integer;
|
||||
begin
|
||||
SkipWhitespace;
|
||||
if filePos <= length(fileContent) then
|
||||
begin
|
||||
if expectPlus then
|
||||
if fileContent[filePos] <> '+' then
|
||||
begin
|
||||
result := false;
|
||||
expectPlus := false;
|
||||
exit;
|
||||
end else
|
||||
inc(filePos);
|
||||
|
||||
case fileContent[filePos] of
|
||||
'+': raise exception.Create('Unexpected "+"');
|
||||
'''': begin
|
||||
inc(filePos);
|
||||
while (filePos <= length(fileContent)) do
|
||||
begin
|
||||
if fileContent[filePos] = '''' then
|
||||
begin
|
||||
inc(filePos);
|
||||
if (filePos <= length(fileContent)) and (fileContent[filePos] = '''') then
|
||||
begin
|
||||
AppendChar('''');
|
||||
inc(filePos);
|
||||
end
|
||||
else break;
|
||||
end else
|
||||
if fileContent[filePos] in[#10,#13] then
|
||||
raise Exception.Create('Unexpected end of line')
|
||||
else
|
||||
begin
|
||||
AppendChar(fileContent[filePos]);
|
||||
inc(filePos);
|
||||
end;
|
||||
end;
|
||||
if (filePos <= length(fileContent)) and (fileContent[filePos] = '#') then
|
||||
expectPlus := false
|
||||
else
|
||||
expectPlus := true;
|
||||
result := true;
|
||||
end;
|
||||
'#': begin
|
||||
inc(filePos);
|
||||
charCode := ParseNumber;
|
||||
if (charCode < 0) or (charCode > 255) then
|
||||
raise exception.Create('Character code out of bounds');
|
||||
AppendChar(chr(charCode));
|
||||
if (filePos <= length(fileContent)) and (fileContent[filePos] in['#','''']) then
|
||||
expectPlus := false
|
||||
else
|
||||
expectPlus := true;
|
||||
result := true;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
result := false;
|
||||
expectPlus := false;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
result := false;
|
||||
expectPlus := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
result := TMemoryStream.Create;
|
||||
expectPlus := false;
|
||||
if not ParseStringPart then raise exception.Create('Expecting string');
|
||||
repeat
|
||||
if ignoreCommas then
|
||||
begin
|
||||
SkipWhitespace;
|
||||
if (filePos <= length(fileContent)) and (fileContent[filePos] = ',') then
|
||||
begin
|
||||
inc(filePos);
|
||||
expectPlus := false;
|
||||
end;
|
||||
end;
|
||||
until not ParseStringPart;
|
||||
end;
|
||||
|
||||
procedure ReadContent;
|
||||
var
|
||||
bytesRead: integer;
|
||||
begin
|
||||
setlength(fileContent,AStream.Size-AStream.Position);
|
||||
bytesRead := AStream.Read(fileContent[1],length(fileContent));
|
||||
setlength(fileContent, bytesRead);
|
||||
filePos := 1;
|
||||
end;
|
||||
|
||||
function StreamToUTF8String(AStream: TStream): utf8String;
|
||||
begin
|
||||
setlength(result, AStream.Size);
|
||||
AStream.Position := 0;
|
||||
AStream.Read(result[1], length(result));
|
||||
AStream.Free;
|
||||
end;
|
||||
|
||||
var
|
||||
entryName: utf8string;
|
||||
entryType: utf8string;
|
||||
entryContent: TStream;
|
||||
inArray: boolean;
|
||||
|
||||
begin
|
||||
Clear;
|
||||
ReadContent;
|
||||
while filePos <= length(fileContent) do
|
||||
begin
|
||||
if (upcase(fileContent[filePos]) = upcase(entryStart[1])) and
|
||||
(CompareText(copy(fileContent,filePos,length(entryStart)),entryStart)=0) then
|
||||
begin
|
||||
inc(filePos, length(entryStart));
|
||||
entryName := StreamToUTF8String(ParseString(false));
|
||||
SkipComma;
|
||||
entryType := StreamToUTF8String(ParseString(false));
|
||||
SkipComma;
|
||||
|
||||
SkipWhitespace;
|
||||
if (filePos <= length(fileContent)) and (fileContent[filePos] = '[') then
|
||||
begin
|
||||
inArray := true;
|
||||
inc(filePos);
|
||||
end else
|
||||
inArray := false;
|
||||
entryContent := ParseString(inArray);
|
||||
SkipWhitespace;
|
||||
if inArray then
|
||||
begin
|
||||
if (filePos <= length(fileContent)) and (fileContent[filePos] = ']') then
|
||||
inc(filePos)
|
||||
else
|
||||
raise exception.Create('Expecting "]"');
|
||||
end;
|
||||
|
||||
if entryType = 'FORMDATA' then
|
||||
AddEntry(TFormDataEntry.Create(self,entryName,entryContent))
|
||||
else
|
||||
AddEntry(TLazResourceEntry.Create(self,entryName,entryType,entryContent));
|
||||
|
||||
if (filePos+length(entryEnd)-1 <= length(fileContent)) and (CompareText(copy(fileContent,filePos,length(entryEnd)),entryEnd)=0) then
|
||||
inc(filePos,length(entryEnd))
|
||||
else
|
||||
raise exception.Create('Expecting "'+entryEnd+'"');
|
||||
end else
|
||||
if fileContent[filePos] in whiteSpace then
|
||||
inc(filePos)
|
||||
else
|
||||
raise exception.Create('Unexpected character "'+fileContent[filePos]+'"');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazResourceContainer.CreateEntry(AName: utf8string; AExtension: utf8string;
|
||||
AContent: TStream): TMultiFileEntry;
|
||||
var
|
||||
binContent: TMemoryStream;
|
||||
begin
|
||||
if UTF8CompareText(AExtension,'lfm')=0 then
|
||||
begin
|
||||
binContent := TMemoryStream.Create;
|
||||
try
|
||||
AContent.Position:= 0;
|
||||
LRSObjectTextToBinary(AContent, binContent);
|
||||
result := TFormDataEntry.Create(self,AName,binContent);
|
||||
except
|
||||
on ex:Exception do
|
||||
begin
|
||||
binContent.Free;
|
||||
result := nil;
|
||||
end;
|
||||
end;
|
||||
AContent.Free;
|
||||
end
|
||||
else
|
||||
result := TLazResourceEntry.Create(self,AName,UTF8UpperCase(AExtension),AContent);
|
||||
end;
|
||||
|
||||
procedure TLazResourceContainer.SaveToStream(ADestination: TStream);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to Count-1 do
|
||||
TLazResourceEntry(Entry[i]).Serialize(ADestination);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in new issue
Block a user