Version:0.9 StartHTML:0000000105 EndHTML:0000043715 StartFragment:0000001037 EndFragment:0000043699
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.