Version:0.9 StartHTML:0000000105 EndHTML:0000043715 StartFragment:0000001037 EndFragment:0000043699 mXScriptasHTML
program CompressServices2;

//Purpose: implement a service routine based on a class of a unit, locs= 220
//uses Unit: ..\maxbox3\examples\units\shellZipTool.PAS
//we compress folder ..\examples\earthplay2 and decompress it 

{type
  TShellZip = class(TObject)
  private
    FFilter: string;
    FZipfile: WideString;
    shellobj: OleVariant;

    procedure CreateEmptyZip;
    function GetNameSpaceObj(x:OleVariant):OleVariant;
    function GetNameSpaceObj_zipfile:OleVariant;
  public
     procedure ZipFolder(const sourcefolder: WideString);
     procedure Unzip(const targetfolder: WideString);
     property Zipfile: WideString read FZipfile write FZipfile;
     property Filter: string read FFilter write FFilter;
  end;}

Const
  SHCONTCH_NOPROGBOX = 4;
  SHCONTCH_AUTORENAME = 8;
  SHCONTCH_RESPONDYESTOALL = 16;
  SHCONTF_INCHIDDEN = 128;
  SHCONTF_FOLDS = 32;
  SHCONTF_NONFOLDS = 64;
  AZIPFILE = 'maxzip2.zip';
   
 var zipfile: widestring;
     shellObj: OlEVariant;


function NumProcessThreads2: integer;
var
  hsnapshot: THandle;
  Te32: TTHREADENTRY32;
  proch: dword;
begin
  Result:= 0;
  proch:= GetCurrentProcessID;
  hSnapShot:= CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
  //Te32.dwSize:= sizeof(TTHREADENTRY32);
  if Thread32First(hSnapShot, Te32) then begin
    if te32.th32OwnerProcessID = proch then
      inc(Result);
    while Thread32Next(hSnapShot, Te32) do begin
      if te32.th32OwnerProcessID = proch then
        inc(Result);
    end;
  end;
  CloseHandle(hSnapShot);
end;


//****************************** from unit shellZipTool.PAS
function IsValidDispatch(const v: OleVariant): Boolean;
begin
  result:= (VarType(v)=varDispatch);// and Assigned(TVarData(v).VDispatch);
end;       
       
function TShellZip_GetNameSpaceObj(ax: Variant): Variant;
begin
  // WARNING: the argument of .NameSpace must be a OleVariant
  // don't change "x" to string or WideString
  try
    Result:= shellobj.NameSpace(ax);
  except
    showmessage('Not a valid folder or namespace!')
  end;  
end;


function TShellZip_GetNameSpaceObj_zipfile: OleVariant;
begin
  Result:= TShellZip_GetNameSpaceObj(Zipfile);
  if not IsValidDispatch(Result) then begin
  EInvalidOperation.Create; //('<%s> invalid zipfile [zipfile]');
  //EInvalidOperation.CreateFmt('<%s> invalid zipfile', [zipfile]);
     raise; //CreateFmt('<%s> invalid zipfile', [zipfile]);
  end;   
end;       


procedure TShellZip_CreateEmptyZip;
var i: integer;
  //ezip: TByteArray; = (80,75,5,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  ezip: TByteDynArray;
  ms: TMemoryStream;
begin
  SetLength(ezip, 25);   //for ZIP Header
  ezip[0]:=80; ezip[1]:=75; ezip[2]:=5; ezip[3]:=6; 
  for i:= 4 to 23 do ezip[i]:= 0; 

  zipfile:= exepath+'examples\'+AZIPFILE;
  // create a new empty ZIP file
  ms:= TMemoryStream.Create;
  try
    //ms.WriteBuffer array of byte of dynamic size;
    ms.WriteBufferABD(ezip, length(ezip));
    ms.SaveToFile(Zipfile);
  finally
    ms.Free;
  end;
end;


procedure TShellZipZipFolder(const sourcefolder: WideString);
var
  srcfldr, destfldr, shellfldritems: OleVariant;
  numt: integer;
  filter: string;
begin
  zipfile:= exepath+'examples\'+AZIPFILE;
  if not FileExists(zipfile) then 
     TShellZip_CreateEmptyZip;
  numt:= NumProcessThreads;
  //almost  numt:= 1;
  shellobj:= CreateOleObject('Shell.Application');
  srcfldr:= TShellZip_GetNameSpaceObj(sourcefolder);
  if not IsValidDispatch(srcfldr) then
     //raise; //EInvalidOperation.CreateFmt('<%s> invalid source', [sourcefolder]);
     writeln('EInvalidOperation.CreateFmt(invalid source');

  destfldr:= TShellZip_GetNameSpaceObj_zipfile;     
  shellFldritems:= srcfldr.Items;
  if (filter <> '') then
    shellFldritems.Filter(SHCONTF_INCHIDDEN or SHCONTF_NONFOLDS or SHCONTF_FOLDS,filter);
  destfldr.CopyHere(shellFldritems, 0);
  // wait till all shell threads are terminated
  while NumProcessThreads <> numt do
    sleep(100);
end;

procedure TShellZip_Unzip(const targetfolder: WideString);
var
  srcfldr, destfldr, shellfldritems: OleVariant;
  filter: string;
begin
  zipfile:= exepath+'examples\'+AZIPFILE;

  shellobj:= CreateOleObject('Shell.Application');
  if DirectoryExists(targetfolder) = false then  //in case of
               CreateDir(targetfolder);
  srcfldr:= TShellZip_GetNameSpaceObj_zipfile;
  destfldr:= TShellZip_GetNameSpaceObj(targetfolder);
  if not IsValidDispatch(destfldr) then
     raise; //EInvalidOperation.CreateFmt('<%s> invalid folder', [targetfolder]);
  shellfldritems:= srcfldr.Items;
  if (filter <> '') then
    shellfldritems.Filter(SHCONTF_INCHIDDEN or SHCONTF_NONFOLDS or SHCONTF_FOLDS,filter);
  destfldr.CopyHere(shellfldritems, SHCONTCH_NOPROGBOX or SHCONTCH_RESPONDYESTOALL);
end;


//***************************Services Provider**********************************
procedure XCompress(azipfolder, azipfile: string);
begin
  with TShellZip.create do begin
    zipfile:= azipfile;
    ZipFolder(azipfolder);
    Free;
  end;  
 //compress
end;


procedure XDeCompress(azipfolder, azipfile: string);
begin
  with TShellZip.create do begin
    zipfile:= azipfile;
    if DirectoryExists(azipfolder) = false then
         CreateDir(azipfolder);
    UnZip(azipfolder);
    Free;
 end;  
 //decompress
end;


var
   //incomeReal: TIncomeRealIntf;
   interlist: TStringlist;
   i: integer;
begin
   //JvZlibMultiple.DecompressFile('h:\test.zip','h:\test',true,true) 
   //procedure TShellZipZipFolder(const sourcefolder: WideString);
   
   //TShellZipZipFolder(exepath+'examples\earthplay2');
   //TShellZip_UnZip(exepath+'examples\decompress2');

   TShellZip_CreateEmptyZip;
   
   //XCompress(exepath+'examples\earthplay2', exepath+'examples\maxboxziptest.zip');
   Writeln('thread count: '+inttoStr(NumProcessThreads));
   //XDeCompress(exepath+'examples\Decompress2', exepath+'examples\maxboxziptest.zip');
   
   //Compress(exepath+'examples\earthplay2', exepath+'examples\maxboxziptest2.zip');
   Writeln('thread count: '+inttoStr(NumProcessThreads));
   //DeCompress(exepath+'examples\Decompress2', exepath+'examples\maxboxziptest2.zip');

   writeln(inttoStr(BytesPerCardinal));
   writeln(inttoStr64(minint64));
   writeln(inttoStr64(maxint64));
   writeln(inttoStr64(mincardinal));
   writeln(inttoStr64(maxcardinal));
   writeln(inttoStr(minnativeint));
   writeln(inttoStr(maxnativeint));
   
   {interlist:= TStringlist.create;
   JCLLocalesInfoList(interlist, 2);
   for i:= 1 to interlist.count-1 do 
     writeln(interlist[i]);
   interlist.Free;}  
   
   //LetPDFGen;
end.

-------------------------------------------------



   {if QueryInterface(IIncomeInt, incomeIntRef) = S_OK
      then begin //_addRef; test
        SetRate(strToInt(edtZins.text),
                       strToInt(edtJahre.text));
        cIncome:=strTofloat(edtBetrag.text);
        cIncome:= GetIncome(cIncome);
      end;}

   IInterface  = interface
     ['{00000000-0000-0000-C000-000000000046}']
     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
     function _AddRef: Integer; stdcall;
     function _Release: Integer; stdcall;
   end;
 
    IIncomeInt  = interface (IUnknown)
      ['{DBB42A04-E60F-41EC-870A-314D68B6913C}']
      function GetIncome(const aNetto: Extended): Extended; stdcall;
      function GetIncome2(const aNetto: Currency): Currency; stdcall;
      function GetRate: Extended;
      function queryDLLInterface(var queryList: TStringList): TStringList;
              stdcall;
      function queryDLLInterfaceTwo(var queryList: TStringList): TStringList;
              stdcall;
      procedure SetRate(const aPercent, aYear: integer); stdcall;
      //property Rate: Double read GetRate;
    end; 
    
    
  
 unit ShellZipTool;

interface

type
  TShellZip = class(TObject)
  private
    FFilter: string;
    FZipfile: WideString;
    shellobj: Olevariant;

    procedure CreateEmptyZip;
    function GetNameSpaceObj(x:OleVariant):OleVariant;
    function GetNameSpaceObj_zipfile:OleVariant;

  public
     procedure ZipFolder(const sourcefolder:WideString);
     procedure Unzip(const targetfolder: WideString);

     property Zipfile:WideString read FZipfile write FZipfile;
     property Filter:string read FFilter write FFilter;
  end;

function NumProcessThreads: integer;



implementation

uses Classes, Comobj, Windows, Tlhelp32, SysUtils, Variants;

const
  SHCONTCH_NOPROGRESSBOX = 4;
  SHCONTCH_AUTORENAME = 8;
  SHCONTCH_RESPONDYESTOALL = 16;
  SHCONTF_INCLUDEHIDDEN = 128;
  SHCONTF_FOLDERS = 32;
  SHCONTF_NONFOLDERS = 64;


function IsValidDispatch(const v:OleVariant):Boolean;
begin
  result := (VarType(v)=varDispatch) and Assigned(TVarData(v).VDispatch);
end;


function NumProcessThreads: integer;
var
  hsnapshot: THandle;
  Te32: TTHREADENTRY32;
  proch: dword;
begin
  Result := 0;

  proch := GetCurrentProcessID;

  hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);

  Te32.dwSize := sizeof(TTHREADENTRY32);

  if Thread32First(hSnapShot, Te32) then
  begin
    if te32.th32OwnerProcessID = proch then
      inc(Result);

    while Thread32Next(hSnapShot, Te32) do
    begin
      if te32.th32OwnerProcessID = proch then
        inc(Result);
    end;
  end;
  CloseHandle(hSnapShot);
end;



{ TShellZip }

procedure TShellZip.CreateEmptyZip;
const
  emptyzip: array[0..23] of byte = (80,75,5,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
var
  ms: TMemoryStream;
begin
  // create a new empty ZIP file
  ms := TMemoryStream.Create;
  try
    ms.WriteBuffer(emptyzip, sizeof(emptyzip));
    ms.SaveToFile(Zipfile);
  finally
    ms.Free;
  end;
end;

function TShellZip.GetNameSpaceObj(x:OleVariant): OleVariant;
begin
  // WARNING:
  // the argument of .NameSpace must be a OleVariant
  // don't change "x" to string or WideString
  Result := shellobj.NameSpace(x);
end;

function TShellZip.GetNameSpaceObj_zipfile: OleVariant;
begin
  Result := GetNameSpaceObj(Zipfile);
  if not IsValidDispatch(Result) then
     raise EInvalidOperation.CreateFmt('<%s> invalid zipfile', [zipfile]);
end;


procedure TShellZip.ZipFolder(const sourcefolder: WideString);
var
  srcfldr, destfldr: OleVariant;
  shellfldritems: Olevariant;
  numt: integer;
begin
  if not FileExists(zipfile) then
  begin
    CreateEmptyZip;
  end;

  numt := NumProcessThreads;

  shellobj := CreateOleObject('Shell.Application');

  srcfldr := GetNameSpaceObj(sourcefolder);
  if not IsValidDispatch(srcfldr) then
     raise EInvalidOperation.CreateFmt('<%s> invalid source', [sourcefolder]);

  destfldr := GetNameSpaceObj_zipfile;

  shellfldritems := srcfldr.Items;

  if (filter <> '') then
    shellfldritems.Filter(SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS,filter);

  destfldr.CopyHere(shellfldritems, 0);

  // wait till all shell threads are terminated
  while NumProcessThreads <> numt do
  begin
    sleep(100);
  end;
end;


procedure TShellZip.Unzip(const targetfolder: WideString);
var
  srcfldr, destfldr: Olevariant;
  shellfldritems: Olevariant;
begin
  shellobj := CreateOleObject('Shell.Application');

  srcfldr := GetNameSpaceObj_zipfile;

  destfldr := GetNameSpaceObj(targetfolder);
  if not IsValidDispatch(destfldr) then
     raise EInvalidOperation.CreateFmt('<%s> invalid target folder', [targetfolder]);

  shellfldritems := srcfldr.Items;
  if (filter <> '') then
    shellfldritems.Filter(SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS,filter);

  destfldr.CopyHere(shellfldritems, SHCONTCH_NOPROGRESSBOX or SHCONTCH_RESPONDYESTOALL);
end;

end.


// to do for 3.9.8.8

tutorial 22 services programming
Genau das ist das Problem.
Die Funktion NameSpace() akzeptiert als Argument nur ein Variant.
WideStrings oder Strings führen zu dem Fehler, dass zwar ein Ergebnis vom Typ varDispatch zurückgeliefert wird, aber der Zeiger = nil ist.
Leichte Schlamperei von Microsoft!

Wichtig ist übrigens, dass die Zipdatei mit absolutem Pfad angegeben wird.
zusammenfalten · markieren
Delphi-Quellcode:

Code:
add createfmt
EInvalidOperation.CreateFmt('<%s> invalid zipfile', [zipfile]); 
add TvarData
Assigned(TVarData(v).VDispatch);
add writebuffer with array of byte
    ms.WriteBuffer(emptyzip, sizeof(emptyzip));
add unit dir in distribution

add getcurrentprocessid
  proch := GetCurrentProcessID;
alias to currentprocessid //indy ?
add unit 
JclCompression.pas 
or ShellZipTool from application.shell;

procedure LetPDFGen;
var
lPdf   : TPdfDocument;
lPage  : TPdfPage;
  //s2: string;
begin
  //lPdf := TPdfDocument.Create(true, 400, true ,NIL);
  lPdf:= TPdfDocument.Create1;
  try
    lPdf.Info.Author        := 'Tester';
    lPdf.Info.CreationDate  := Now;
    lPdf.Info.Creator       := 'Tester';
    lPdf.DefaultPaperSize   := psA4;
    lPage := lPDF.AddPage;
    //lPDF.Canvas.SetFont1('Helvetica',10.0,[]);
    lPDF.Canvas.SetLeading(lPDF.Canvas.Page.FontSize);
    lPDF.Canvas.SetLineWidth(0.1);
    lPdf.Canvas.BeginText;
    lPdf.Canvas.TextOut( 300, 700,  'This is some text as pdf.');
    lPdf.Canvas.EndText;
    lPdf.SaveToFile(Exepath+'examples\myfirsttest.pdf');
  finally 
    lPdf.Free;
  end;
  //RegCreateKey(
end;    


Ja genau, der Projektantrag steht jeweils am Kick-Off Meeting im Vordergrund.
Der Projektantrag hat dieselbe Struktur wie bei der Eingabe, nur wird das Vorgehensmodell und entsprechend der Abstrakt mit dem Lösungsansatz noch nach Absprache und der Abstimmung mit dem Kickoff ergänzt.
Die Idee ist dass sich nach Eingabe des Projektantrags und des definitiven Uploads noch Anpassungen oder sogar die Wahl eines anderen Vorgehensmodell (Prozess) ergeben kann.

Internet of Things
Für das Internet der Dinge entwickeln

Max Kleiner, Inhaber, kleiner kommunikation

Viele sehen im Internet of Things vor allem eines: ein gigantisches Potenzial für neue Geschäftsmodelle. Bald wird die ganze Welt programmierbar sein. Jedes EBike, jede Waschmaschine, Kaffeemaschine, jeder Blutdruckmesser oder jede Armbanduhr wird irgendwie vernetzt sein. Geräte werden untereinander als Physical Computing kommunizieren, sich aufeinander abstimmen. Man geht also nicht mehr ins Internet, sondern das Internet ist Teil von uns, Sensoren messen meinen Blutzucker und berechnen so die nächste Krankenkassenprämie. Es kann auch sein, dass intelligente Gebäude so störanfällig werden, dass der Fahrstuhl des Grauens Wirklichkeit wird. Nette Spielereien oder der Anfang einer neuen solargetriebenen Manufakturindustrie inklusive 3D-Drucker und Roboter in der Altersbetreuung

Max Kleiner bespricht, wie mit Android ein Arduino Board gesteuert wird:

    REST als Command Protocol
    Web to Serial Applications
    Microcontrollers
    Aktoren und Sensoren
    RFIDs sind überall
    

Extern: Settings-User
Extern: Konfiguration-Admin
Intern: Literals-Developer

Identifizierung
• Konfigurationselemente wie Pfad oder Default-Werte
• Doppelte Elemente (String oder numerische Literals)
• Beziehungen der Konfigurationselemente
• Software Version innerhalb der Config Einstellung
• Baseline und zentrale Elemente
• Aufnahme von Konfigurationselementen
• Bibliotheken / Komponenten / Frameworks etc.