unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, StdCtrls, FileUtil, Forms, Controls, Graphics, Dialogs,
Uni, pqconnection, PostgreSQLUniProvider, //requires Devart Unidac from 6.3.12
AbZipper, AbUtils, AbArcTyp,
strutils,
Process;
type
TRepo = record
Name: string;
Owner: string;
UpdatedUNIX: cardinal;
end;
type
TRepos = array of TRepo;
type
{ TForm1 }
TForm1 = class(TForm)
Memo1: TMemo;
PostgreSQLUniProvider1: TPostgreSQLUniProvider;
UniConnection1: TUniConnection;
UniQuery1: TUniQuery;
UniTransaction1: TUniTransaction;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
function ZipFolder(AFolderPath, AFileName: string): boolean;
private
_Repos: TRepos;
_ServerIP: string;
_ClonedInfo: TStringList;
procedure RunClone(ARepo: TRepo);
function Occurrences(const ADelimiter, AText: string): integer;
end;
var
Form1: TForm1;
const
{$IFDEF WINDOWS}
_Delimiter = '\';
{$ENDIF}
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
app_folder: string;
i: word;
begin
_ClonedInfo := TStringList.Create;
app_folder := ExtractFileDir(Application.ExeName);
try
_ServerIP := '192.168.1.26';
UniConnection1.Server := _ServerIP;
UniConnection1.Port := 5432;
UniConnection1.Username := 'postgres';
UniConnection1.Password := 'admin';
UniConnection1.ProviderName := 'PostgreSQL';
UniConnection1.Database := 'db_gogs';
UniConnection1.Connect;
UniTransaction1.DefaultConnection := UniConnection1;
UniQuery1.Transaction := UniTransaction1;
UniQuery1.Connection := UniConnection1;
UniQuery1.SQL.Text := 'select r.name, u.name, r.updated_unix from repository r, public.user u where r.owner_id = u.id';
UniQuery1.ExecSQL;
SetLength(_Repos, UniQuery1.RecordCount);
UniQuery1.First;
while not UniQuery1.EOF do
begin
_Repos[UniQuery1.RecNo - 1].Name := UniQuery1.Fields[0].AsString;
_Repos[UniQuery1.RecNo - 1].Owner := UniQuery1.Fields[1].AsString;
_Repos[UniQuery1.RecNo - 1].UpdatedUNIX := UniQuery1.Fields[2].AsInteger;
RunClone(_Repos[UniQuery1.RecNo - 1]);
UniQuery1.Next;
end;
//sleep(2000);
for i := low(_Repos) to high(_Repos) do
begin
if Occurrences(_Delimiter, app_folder) > 1 then
begin
ZipFolder(app_folder + _Delimiter + _Repos[i].Name, _Repos[i].Name + '.zip');
end
else
begin
if Pos(_Delimiter, app_folder) = Length(app_folder) then
begin
ZipFolder(app_folder + _Repos[i].Name, _Repos[i].Name + '.zip');
end
else
begin
ZipFolder(app_folder + _Delimiter + _Repos[i].Name, _Repos[i].Name + '.zip');
end;
end;
end;
except
on E: Exception do
begin
ShowMessage(E.Message);
end;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(_ClonedInfo) then
FreeAndNil(_ClonedInfo);
end;
procedure TForm1.RunClone(ARepo: TRepo);
var
url: string;
p: TProcess;
begin
url := 'http://' + _ServerIP + ':3000/' + ARepo.Owner + '/' + ARepo.Name + '.git';
Memo1.Append(url);
p := TProcess.Create(nil);
p.Executable := 'git';
p.Parameters.Add('clone');
p.Parameters.Add(url);
p.ShowWindow := swoHIDE;
p.Execute;
FreeAndNil(p);
end;
function TForm1.ZipFolder(AFolderPath, AFileName: string): boolean;
var
z: TAbZipper;
begin
Result := True;
if DirectoryExists(AFolderPath) then
begin
try
Memo1.Append('zipping: ' + AFolderPath);
z := TAbZipper.Create(self);
z.ArchiveType := atZip;
z.StoreOptions := [soRecurse];
if Occurrences(_Delimiter, AFolderPath) > 1 then
begin
z.BaseDirectory := Copy(AFolderPath, 1, LastDelimiter(_Delimiter, AFolderPath));
end
else
z.BaseDirectory := AFolderPath;
z.FileName := Copy(AFolderPath, 1, LastDelimiter(_Delimiter, AFolderPath)) + AFileName;
z.AddFiles(AFolderPath + _Delimiter + '*', faAnyFile);
z.Save;
z.CloseArchive;
finally
FreeAndNil(z);
end;
end
else
Result := False;
end;
function TForm1.Occurrences(const ADelimiter, AText: string): integer;
var
offset: integer;
begin
Result := 0;
offset := PosEx(ADelimiter, AText, 1);
while offset <> 0 do
begin
Inc(Result);
offset := PosEx(ADelimiter, AText, offset + length(ADelimiter));
end;
end;
end.