{
 FileApplet.pas
   'PP applet' for iziBasic
   Version 1.0ß1 - April 14, 2007
   by Laurent Duveau
     Web Site = http://www.aldweb.com
     e-Mail   = info@aldweb.com


-----------------------
What is FileApplet.pas?
-----------------------

FileApplet.pas is a fully featured 'PP applet' for iziBasic
which is made to delete and copy any type of file, when the
COPY and KILL statements in iziBasic are provided with
restrictions for security purposes.

This 'PP applet' can be used as is in your iziBasic projects.
Please give a look to the FileApplet.ibas sample program source
code to see an example of how to access it.


--------------------------
How to use FileApplet.pas?
--------------------------

SYNTAX

output$ = CALLPP$(100,input$)
 input$ : "NumFunction[1 Char],Parameter1[,Parameter2]"
 output$: "1" if success, 0 if failure


FUNCTIONS

Delete one file
 Parameters: "1,FileName"

Copy one file to another one
 Parameters : "2,SourceFileName,TargetFileName"


-------------------------------
Parametrization and integration
in an iziBasic project
-------------------------------

Step #1: Replace the 'LDFI' CreatorID in the first line of the
         source code below to the CreatorID defined in your
         iziBasic source code (see CREATORID compiling directive)
         Also replace the 'FileDanger' label in the second line
         to the name of your application (the part of the iziBasic
         source code file name prior to the '.ibas' extension)

Step #2: Compile your iziBasic project

Step #3: Compile this 'PP applet'
}


{$code appl,LDFI,code,100}
program FileDanger;

type
 iBasFunType=function(S:string):string;

var
 iBasCallPP:iBasFunType;


// -----------------------
// Palm OS API definitions
// -----------------------

{$i PalmAPI.pas}
function  DmDeleteRecord(dbP:DmOpenRef;index:UInt16):Err; inline(SYSTRAP,$A057);


// -------------------------
// General purpose functions
// -------------------------

function ExtractStrI(const sMyString:String;index:UInt8):string;
var
 sResult:String;
 i,j:UInt8;
begin
 sResult:='';
 j:=1;
 for i:=1 to Length(sMyString) do
  if sMyString[i]=',' then
   j:=j+1
  else
   if j=index then
    sResult:=sResult+sMyString[i];
 ExtractStrI:=sResult;
end;


function IntToString(N:integer):string;
var
 S:string;
begin
 StrIToA(S,N);
 IntToString:=S;
end;


// ---------------------------
// RsrcDB management functions
// ---------------------------

function DeleteFile(DBName:String):boolean;
var
 dbID:UInt32;
begin
 if DBName='' then
  DeleteFile:=false
 else begin
  dbID:=DmFindDatabase(0,DBName);
  if dbID=0 then
   DeleteFile:=false
  else
   DeleteFile:=DmDeleteDatabase(0,dbID)=0;
 end;
end;


function CopyFile(const DBSource,DBTarget:string):boolean;
const
 dmHdrAttrResDB=1;
 dmHdrAttrBackup=8;
 dmHdrAttrCopyPrevention=64;
 DmMaxRecordIndex=-1;
var
 IDSource,IDTarget:LocalID;
 RefSource,RefTarget:DmOpenRef;
 MyResH:Memhandle;
 MyResP:MemPtr;
 MyResS:UInt32;
 h:MemHandle;
 p:MemPtr;
 NBRecords:Integer;
 i,j:UInt16;
 dbID:LocalID;
 resType:UInt32;
 resID:UInt16;
 name:String;
 attributes,ResAttr:UInt16;
 t,c:UInt32;
 Erreur:Err;
begin
 IDTarget:=DmFindDatabase(0,DBTarget);
 if IDTarget>0 then
  Erreur:=1  // Target File already exists
 else begin
  IDSource:=DmFindDatabase(0,DBSource);
  if IDSource=0 then
   Erreur:=1  // Source File does not exist
  else begin
   Erreur:=DmDatabaseInfo(0,IDSource,name,attributes,nil,nil,nil,nil,nil,nil,nil,t,c);
   if Erreur=0 then begin  // Attributes from Source File were read
    ResAttr:=attributes and dmHdrAttrResDB;  // Is Source File a data or a resource file?
    name:=DBTarget;
    Erreur:=DmCreateDatabase(0,name,c,t,ResAttr=1);
    if Erreur=0 then begin  // Target File was created
     IDTarget:=DmFindDatabase(0,name);
     if IDTarget=0 then
      Erreur:=1 // Target File was not found
     else begin
      attributes:=attributes or dmHdrAttrBackup;  // Set backup bit for Target File
      Erreur:=DmSetDatabaseInfo(0,IDTarget,nil,attributes,nil,nil,nil,nil,nil,nil,nil,nil,nil);
      if Erreur=0 then begin  // Everything OK, we can now proceed with the file copy
       RefSource:=DmOpenDatabase(0,IDSource,dmModeReadOnly);
       if ResAttr=1 then  // Resource File to copy
        NBRecords:=DmNumResources(RefSource)
       else  // Data File to copy
        NBRecords:=DmNumRecords(RefSource);
       if NBRecords>0 then begin  // Source File is not empty, there are records to copy
        RefTarget:=DmOpenDatabase(0,IDTarget,dmModeReadWrite);
        if ResAttr=1 then begin  // Resource File copying...
         for i:=0 to NBRecords-1 do begin
          MyResH:=DmGetResourceIndex(RefSource,i);
          MyResS:=MemHandleSize(MyResH);
          MyResP:=MemHandleLock(MyResH);
          DmResourceInfo(RefSource,i,resType,resID,nil);
          h:=DmNewResource(RefTarget,resType,resID,MyResS);
          if h<>nil then begin
           p:=MemHandleLock(h);
           DmSet(p,0,MyResS,0);
           DmWrite(p,0,MyResP,MyResS);
           MemHandleUnlock(h);
           DmReleaseResource(h);
          end;
          MemHandleUnlock(MyResH);
          DmReleaseResource(MyResH);
         end;
        end
        else begin  // Data File copying...
         for i:=0 to NBRecords-1 do begin
          MyResH:=DmGetRecord(RefSource,i);
          if MyResH<>nil then begin  // Valid record
           MyResS:=MemHandleSize(MyResH);
           MyResP:=MemHandleLock(MyResH);
           j:=i;
           h:=DmNewRecord(RefTarget,j,MyResS);
           p:=MemHandleLock(h);
           DmSet(p,0,MyResS,0);
           DmWrite(p,0,MyResP,MyResS);
           MemHandleUnlock(h);
           DmReleaseRecord(RefTarget,j,false);
           MemHandleUnlock(MyResH);
          end
          else begin  // Deleted record, not yet synchronized with HotSync
           j:=i;
           DmNewRecord(RefTarget,j,1);
           DmReleaseRecord(RefTarget,j,false);
           DmDeleteRecord(RefTarget,j);
          end;
          DmReleaseRecord(RefSource,i,false);
         end;
        end;
       end;
       DmCloseDatabase(RefTarget);
      end;
      DmCloseDatabase(RefSource);
     end;
    end;
   end;
  end;
 end;
 CopyFile:=Erreur=0;
end;


// ------------------
// PP applet function
// ------------------

function CallPP(S:string):string;
var
 WhatToDo:byte;
 ReportDone:boolean;
begin
 WhatToDo:=StrAToI(S[1]);
 case WhatToDo of
  1: ReportDone:=DeleteFile(ExtractStrI(S,2));
  2: ReportDone:=CopyFile(ExtractStrI(S,2),ExtractStrI(S,3));
  else
   ReportDone:=false;
 end;
 CallPP:=IntToString(Ord(ReportDone));
end;


begin
 iBasCallPP:=CallPP;
end.

' FileDanger.ibas

{CREATORID "LDFI"}
{VERSION "1.0"}
{RESOURCEFILE "FileApplet.rsrc"}

BEGIN
 GOSUB _WhatToDo
 REPEAT
  INPUT K$
  SELECT CASE K$
   CASE "1"
    T$="2,MemoDB,MemoDB~copy"
    GOSUB _DoIt
   CASE "2"
    T$="1,MemoDB~copy"
    GOSUB _DoIt
   CASE "3"
    T$="2,iziBasic,iziBasic~copy"
    GOSUB _DoIt
   CASE "4"
    T$="1,iziBasic~copy"
    GOSUB _DoIt   
  END SELECT 
 UNTIL K$="5"
END

_WhatToDo:
 PRINT "What to do?"
 PRINT "1. Copy MemoDB to MemoDB~copy"
 PRINT "2. Delete MemoDB~copy"
 PRINT "3. Copy iziBasic to iziBasic~copy"
 PRINT "4. Delete iziBasic~copy"
 PRINT "5. Exit"
RETURN

_DoIt:
 P$=CALLPP$(100,T$)
 CLS
 GOSUB _WhatToDo
 PRINT
 PRINT ">> ";
 PRINT K$;
 PRINT " -> ";
 IF P$="1" THEN
  PRINT "I did it!"
 ELSE
  PRINT "Something went wrong..." 
 ENDIF
RETURN

{ PalmAPI
Version 7 - November 24, 2004
(...)