|
|
||
| Home | SwiftForth Archive | SwiftX Archive | |
The following program uses a configuration file to check which directories
and files need to be copied to or from my USB stick to synchronize my work and
home PC. Only changed files and only files already on the stick are copied.
The program reads the config file to find what directories to check.
Then it checks this directory with subdirectories on the stick and compares them
with the corresponding files on the PC.
- If the file is newer on the PC it is copied to the stick.
- If the file is newer on the stick it is copied to the PC.
- If the files have the same date, no action is taken.
Maybe it can offer some ideas.
Config file: >>>>>>>>>>>>>>>>>>>>>>>>>
->\Sync\CW32
c:\winprog\CW32
->\Sync\Data
d:\Data
->\Sync\Forth
C:\ForthInc\SwiftForth\User
->\Sync\Desktop
D:\Desktop
->\Sync\Notes
C:\Documents and Settings\a792247\Notes
->\Sync\My Brains
D:\My Brains
Program >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
\ ## INIT
Empty
Requires MemMapFile \ MemoryMapped file support
\ ## Data definiton
2Variable bFile
2Variable File1
2Variable File2
2Variable Dir1
2Variable Dir2
\ ## Window handles
0 Value hDataEdit \ ?
0 Value pEditBuffer \ ?S
\ ## Utilities
iCode Skip1 ( Add Len -- Add+1 Len-1 ) \ Skip one char of buffer
0 [EBP] Inc
EBX Dec
Ret End-Code
: Skip2 ( Add Len -- Add+2 Len-2 ) \ Skip two chars of buffer
Skip1 Skip1 ;
\ ## Type to window
-?
: Type ( a l -- )
pEditBuffer zAppend ;
-?
: Cr ( -- )
s\" \n" pEditBuffer zAppend
hDataEdit WM_SETTEXT 0 pEditBuffer SendMessage Drop
;
/Warning
\ ## Registry use
Function: RegCreateKeyEx ( hKey stSubKey Null stClass Flag Sec Null pHandle Disp -- Res )
Function: RegFlushKey ( Key -- Ret )
3 Cells Buffer: bRegistry \ 0 hKey, 1 Data, 2 Length
: Create&OpenKey ( zKey -- )
HKEY_CURRENT_USER Swap 0 z" REG_BINARY" REG_OPTION_NON_VOLATILE
KEY_ALL_ACCESS 0 bRegistry Pad RegCreateKeyEx Drop ;
: SetIntValue ( zValue N -- )
bRegistry 1 Cells + ! bRegistry @ Swap 0 REG_DWORD
bRegistry 1 Cells + 4 RegSetValueEx Drop ;
: GetIntValue ( zValue Def -- N )
bRegistry 1 Cells + !
4 bRegistry 2 Cells + ! bRegistry @ Swap 0 Pad bRegistry 1 Cells +
bRegistry 2 Cells + RegQueryValueEx Drop bRegistry 1 Cells + @ ;
: Flush&CloseKey ( -- )
bRegistry @ RegFlushKey Drop bRegistry @ RegCloseKey Drop ;
\ ## Copy file
Requires Progress
0 Constant PROGRESS_CONTINUE
1 Constant COPY_FILE_FAIL_IF_EXISTS
2 Constant COPY_FILE_RESTARTABLE
Variable fStop
Function: CopyFileEx ( pFrom pTo pCallBack pData fStop COPY_FILE_RESTARTABLE -- Res )
:Noname _Param_0 0> If _Param_2 100 _Param_0 U*/ .Progress Then
PROGRESS_CONTINUE ; 13 CB: pProgress \ Progress callback
: WinCopyFile ( zFrom zTo -- )
z" BMC FileCopy" +Progress
pProgress 0 fStop COPY_FILE_RESTARTABLE CopyFileEx Drop
-Progress
;
\ ## ReadFile
Map-Handle hMapFile \ Mapped File Structure
: ReadMnFile ( -- )
s" SyncFiles.mn" hMapFile Open-Map-File-R/O Drop
hMapFile Map-File-Addr hMapFile Map-File-Len
Dup Allocate Drop Swap 2Dup bFile 2! Move
hMapFile Close-Map-File Drop ;
\ ## File
Function: OpenFile ( pName pStruct Flag -- hFile )
Function: GetFileTime ( hFile pCreate pAccess pWrite -- Res )
Function: CompareFileTime ( pTime1 pTime2 -- Res )
0 Value hFile
136 Buffer: pOfStruct
2Variable WriteTime
: GetFileAge ( a l -- dAge )
0 Locals| B |
256 Allocate Drop To B
B zPlace
0. WriteTime 2!
B pOfStruct OF_READ OpenFile To hFile
hFile 0 0 WriteTime GetFileTime Drop
hFile CloseHandle Drop
B Free Drop
WriteTime 2@ ;
2Variable FileTime1
2Variable FileTime2
0 Value Copy?
0 Value Verbose?
: DoFileCopy ( pf1 pf2 -- )
0 0 Locals| B1 B2 |
Copy? If
256 Allocate Drop To B1
256 Allocate Drop To B2
2@ B2 zPlace 2@ B1 zPlace
B1 B2 WinCopyFile
B1 Free Drop
B2 Free Drop
Else S" - List only!" Type 2Drop Then
;
: DoFile ( a l -- )
Skip2 s\" \n" SplitStr File1 2!
Skip2 s\" \n" SplitStr File2 2!
File1 2@ GetFileAge FileTime1 2!
File2 2@ GetFileAge FileTime2 2!
2Drop
FileTime1 FileTime2 CompareFileTime
Case
-1 Of Cr S" Copy " Type File2 2@ Type S" ---> " Type File1 2@ Type
File2 File1 DoFileCopy EndOf
0 Of Verbose? If Cr S" OK " Type File1 2@ Type Then EndOf
1 Of Cr S" Copy " Type File1 2@ Type S" ---> " Type File2 2@ Type
File1 File2 DoFileCopy EndOf
EndCase
;
\ ## List files in directory ver 2
318 Value zFindFile
: pFileName2 ( a -- z )
44 + ;
: DoDir2 ;
: ParseFile2 ( -- )
ReadMnFile bFile 2@ Begin Dup 0> While
Skip2 s" ~@" SplitStr
Over c@ 100 = If DoDir2 Then
Repeat
2Drop
;
: RecurTest ( -- )
s" Bra!" Type Cr ;
\ ## List files in directory
318 Buffer: pFindFile
0 Value hFindFile
: pFileName ( -- z )
pFindFile 44 + ;
: Dir? ( -- f )
pFindFile @ FILE_ATTRIBUTE_DIRECTORY And 0<> ;
: CopyDirFile ( -- )
0 0 Locals| B1 B2 |
Dir? Not If
MAX_PATH Allocate Drop To B1
MAX_PATH Allocate Drop To B2
Dir1 2@ B1 zPlace s" \" B1 zAppend pFileName zCOunt B1 zAppend
B1 zCount File1 2!
Dir2 2@ B2 zPlace s" \" B2 zAppend pFileName zCOunt B2 zAppend
B2 zCount File2 2!
B1 zCount GetFileAge FileTime1 2!
B2 zCount GetFileAge FileTime2 2!
FileTime1 FileTime2 CompareFileTime
Case
-1 Of Cr S" Copy " Type File2 2@ Type S" ---> " Type File1 2@ Type
File2 File1 DoFileCopy EndOf
0 Of Verbose? If Cr s" OK " Type File1 2@ Type Then EndOf
1 Of Cr s" Copy " Type File1 2@ Type s" ---> " Type File2 2@ Type
File1 File2 DoFileCopy EndOf
EndCase
Then
B1 Free Drop
B2 Free Drop
;
: FindFirst ( pDir -- )
0 Locals| B |
MAX_PATH Allocate Drop To B
2@ B zPlace S" \*.*" B zAppend
B pFindFile FindFirstFile To hFindFile
B Free Drop
;
: FindNext ( -- F )
hFindFile pFindFile FindNextFile
;
: FindAll ( pDir -- )
FindFirst CopyDirFile
Begin
FindNext
Dup If CopyDirFile Then
Not Until
;
\ ## Directory
: DoDir ( a l -- )
Skip2 s\" \n" SplitStr Dir1 2!
Skip2 s\" \n" SplitStr Dir2 2!
2Drop
Dir1 FindAll
;
: ParseFile ( -- )
ReadMnFile bFile 2@ Begin Dup 0> While
Skip2 s" ~@" SplitStr
Over c@ 100 = If DoDir Else DoFile Then
Repeat
2Drop
;
: Sync ( -- )
-1 To Copy?
0 To Verbose?
pEditBuffer Off
ParseFile Cr
S" -------------------" Type Cr
;
: List ( -- )
0 To Copy?
0 To Verbose?
pEditBuffer Off
ParseFile Cr
S" -------------------" Type Cr
;
: VSync ( -- )
-1 To Copy?
-1 To Verbose?
pEditBuffer Off
ParseFile Cr
S" -------------------" Type Cr
;
: VList ( -- )
0 To Copy?
-1 To Verbose?
pEditBuffer Off
ParseFile Cr
S" -------------------" Type Cr
;
\ Program FileSync.exe
\ \\
\ #########################################################
\ ## Data Definition
\ #########################################################
0 Value hParentWindow \ Handle of top window
0 Value ClientW \ Top window's client area width
0 Value ClientH \ Top window's client area height
\ #########################################################
\ ## Window: Data window
\ #########################################################
: DataEditPos ( -- Left Top Width Height )
1 1 1 1 Locals| h w y x |
x \ Fra Venstre
Y \ Fra Topp
ClientW w - x - \ Fra Høyre
ClientH h - y - \ Fra bunn
;
: DataEdit_Create_Window ( -- handle )
0 \ extended style
Z" EDIT" \ window class name
Z" " \ window caption
WS_CHILD \ window style
ES_MULTILINE Or
WS_VSCROLL Or
DataEditPos \ position and size
hWnd \ parent window handle
0 \ window menu handle
hInst \ program instance handle
0 \ creation parameter
CreateWindowEx ;
: DataEdit ( -- Flag )
DataEdit_Create_Window Dup If
Dup SW_NORMAL ShowWindow Drop
Dup UpdateWindow Drop
Dup To hDataEdit
Then
;
\ #########################################################
\ ## LW Menu
\ #########################################################
0 Value hLW_Menu
0 Enum cLW_Menu_About
Enum cLW_Menu_Exit
Enum cLW_Menu_New
Enum cLW_Menu_List
Enum cLW_Menu_vList
Enum cLW_Menu_Sync
Enum cLW_Menu_vSync
Enum cLW_Menu_Test
Drop
Menu LW_Menu
cLW_Menu_List MenuItem "&List"
cLW_Menu_vList MenuItem "Verbose L&ist"
cLW_Menu_Sync MenuItem "&Sync"
cLW_Menu_vSync MenuItem "Verbose S&ync"
cLW_Menu_Exit MenuItem "&Exit"
cLW_Menu_Test MenuItem "&Test"
PopUp "&Help"
cLW_Menu_About MenuItem "&About"
End-PopUp
End-Menu
: LW_Menu_Create ( -- hMenu )
LW_Menu LoadMenuIndirect To hLW_Menu ;
: LW_Menu_Exit ( -- )
hWnd WM_CLOSE 0 0 PostMessage Drop
;
: LW_Menu_About ( -- )
hWnd Z\" FileSync 1.0\nBy BMC\n(c) 2006" Z" LW"
MB_OK MB_ICONINFORMATION Or MB_APPLMODAL Or MessageBox Drop
;
: LW_Menu_Commands ( N -- 0 )
wParam LoWord
Case
cLW_Menu_About Of LW_Menu_About EndOf
cLW_Menu_Exit Of LW_Menu_Exit EndOf
cLW_Menu_List Of List Endof
cLW_Menu_vList Of vList Endof
cLW_Menu_Sync Of Sync Endof
cLW_Menu_vSync Of vSync Endof
cLW_Menu_Test Of RecurTest Endof
EndCase
0 ;
\ #########################################################
\ ## Accellerator Commands
\ #########################################################
: LW_Accelerator_Commands ( -- )
hWnd Z\" Accelerator!" Z" LW"
MB_OK MB_ICONINFORMATION Or MB_APPLMODAL Or MessageBox Drop
;
\ #########################################################
\ ## Child window notification
\ #########################################################
0 Value pEdit
: LW_Control_Commands ( -- )
lParam Case
\ hExitButton Of LW_Menu_Exit EndOf
Endcase
;
\ #########################################################
\ ## WM_COMMAND
\ #########################################################
: LW_Commands ( -- 0 )
lParam 0<> If LW_Control_Commands
Else
wParam HiWord Case
0 Of LW_Menu_Commands EndOf
1 Of LW_Accelerator_Commands EndOf
EndCase
Then
0 ;
[Switch LW_Message_Handler DEFWINPROC ( -- )
WM_COMMAND Runs LW_Commands
Switch]
\ #########################################################
\ ## WM_SIZE
\ #########################################################
: LW_Size ( -- 0 )
lParam LoWord To ClientW
lParam HiWord To ClientH
hDataEdit DataEditPos -1 MoveWindow Drop
0 ;
[+Switch LW_Message_Handler ( -- res )
WM_SIZE Runs LW_Size
Switch]
\ #########################################################
\ ## WM_LBUTTONDOWN
\ #########################################################
: LW_LButtonDown ( -- 0 )
0 ;
[+Switch LW_Message_Handler ( -- res )
WM_LBUTTONDOWN Runs LW_LButtonDown
Switch]
\ #########################################################
\ ## WM_KEYDOWN
\ #########################################################
: DefKey
z(.) 2 .Spart
;
: KeyToDataEdit ( -- )
hDataEdit WM_KEYDOWN wParam lParam SendMessage Drop ;
: LW_KeyDown ( -- 0 )
wParam Case
27 Of LW_Menu_Exit Drop EndOf \ ESC
69 Of LW_Menu_Exit Drop EndOf \ E
88 Of LW_Menu_Exit Drop EndOf \ X
33 Of KeyToDataEdit Drop EndOf \ PgUp
34 Of KeyToDataEdit Drop EndOf \ pgDown
38 Of KeyToDataEdit Drop EndOf \ Up
40 Of KeyToDataEdit Drop EndOf \ Down
73 Of vList Drop EndOf \ I
86 Of vList Drop EndOf \ V
76 Of List Drop EndOf \ L
83 Of Sync Drop EndOf \ S
89 Of vSync Drop EndOf \ Y
112 Of LW_Menu_About Drop EndOf \ F1
DefKey EndCase
0 ;
[+Switch LW_Message_Handler ( -- res )
WM_KEYDOWN Runs LW_KeyDown
Switch]
\ #########################################################
\ ## Window: LW
\ #########################################################
0 Value hLW_App
10 Value WindowSizeX
10 Value WindowSizeY
800 Value WindowSizeW
600 Value WindowSizeH
: MainSize ( -- X Y W H )
WindowSizeX WindowSizeY WindowSizeW WindowSizeH ;
: RegKeyName ( -- A )
z" Software\BMC\FileSync v1.0" ;
Create cLW_Classname ,Z" LW"
:Prune ?Prune -Exit
hLW_App If
hLW_App WM_CLOSE 0 0 SendMessage Drop Then
cLW_Classname hInst UnregisterClass Drop ;
: Turnkey? ( -- flag )
'Main @ [ 'Main @ ] Literal = ;
: LW_Close ( -- 0 )
0 Locals| B |
4 Cells Allocate Drop To B
hParentWindow B GetWindowRect Drop
B @ To WindowSizeX
B 1 Cells + @ To WindowSizeY
B 2 Cells + @ To WindowSizeW
B 3 Cells + @ To WindowSizeH
RegKeyName Create&OpenKey
z" Left" WindowSizeX SetIntValue
z" Top" WindowSizeY SetIntValue
z" Width" WindowSizeW WindowSizeX - SetIntValue
z" Height" WindowSizeH WindowSizeY - SetIntValue
Flush&CloseKey
pEditBuffer Free Drop
hWnd DestroyWindow Drop 0 To hLW_App 0 ;
: LW_Destroy ( -- 0 )
Turnkey? If 0 Exit Then 0 PostQuitMessage Drop 0 ;
: LW_Create ( -- ) \ ?
DataEdit Drop
20480 Allocate Drop To pEditBuffer
0 ;
[+Switch LW_Message_Handler ( -- )
WM_CLOSE Runs LW_Close
WM_DESTROY Runs LW_Destroy
WM_CREATE Runs LW_Create
Switch]
:NoName Msg Loword LW_Message_Handler ; 4 Cb: LW-Callback \ definerer callback med fire param.
: LW_Register_Class ( -- )
cLW_Classname LW-Callback DefaultClass
Drop ; \ Discard return parameter
: LW_Create_Window ( -- handle )
0 \ extended style
cLW_Classname \ window class name
Z" FileSync by BMC" \ window caption
WS_OVERLAPPEDWINDOW \ window style
MainSize \ x y w h position and size
0 \ parent window handle
hLW_Menu \ window menu handle
hInst \ program instance handle
0 \ creation parameter
CreateWindowEx ;
: LW ( -- Flag )
RegKeyName Create&OpenKey
z" Left" WindowSizeX GetIntValue To WindowSizeX
z" Top" WindowSizeY GetIntValue To WindowSizeY
z" Width" WindowSizeW GetIntValue To WindowSizeW
z" Height" WindowSizeH GetIntValue To WindowSizeH
Flush&CloseKey
LW_Menu_Create
LW_Register_Class LW_Create_Window Dup If
Dup SW_NORMAL ShowWindow Drop
Dup UpdateWindow Drop
Dup To hLW_App
Dup To hParentWindow
Then
;
: Go ( -- )
LW If Dispatcher
Else 0 Z" Can't create window" Z" Error" MB_OK
MessageBox
Then ExitProcess ;
' Go 'Main !
Program FileSync.exe
[UnDefined] NoGo [IF] LW [Then]
End >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
On Thu, 07 Aug 2008 16:55:21 +0200, Roger Levy <roger.levy_at_gmail.com> wrote:
> Hi All,
> I wanted to implement an automatic resource-update facility, but I'm not
> sure how to do it in SwiftForth, or where to find out.
>
> I would like to be able to search for a file in a source directory and see
> if we need to copy it to a target directory.
>
> If the source file is found,
>
> 1. If it doesn't exist in the target directory, copy it and exit.
>
> 2. If it exists in the target directory and the source file is newer than
> the target file, copy it and exit.
>
> 3. Else do nothing and exit.
>
>
> Mostly I was just wondering what are the commands to use to 1.) find a file
> in a directory and 2.) check its Last Modified attribute.
>
> Roger
>
>
> ----------------------------------------------------------------------
> sftalk_at_forth.com The SwiftForth programming discussion email list
> To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
> For list command help, send subject "help" to sftalk-request_at_forth.com
> Message archives are located at http://www.forth.com/archive/sftalk
> ----------------------------------------------------------------------
> This list is a forum for SwiftForth users. For product support and
> bug reports, please send email to support_at_forth.com
> ----------------------------------------------------------------------
>
>
> No virus found in this incoming message.
> Checked by AVG.
> Version: 8.0.138 / Virus Database: 270.5.12/1597 - Release Date: 8/7/2008 5:54 AM
>
>
>
-- Med Vennlig Hilsen, Morten A. Steien ---------------------------------------------------------------------- sftalk_at_forth.com The SwiftForth programming discussion email list To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com For list command help, send subject "help" to sftalk-request_at_forth.com Message archives are located at http://www.forth.com/archive/sftalk ---------------------------------------------------------------------- This list is a forum for SwiftForth users. For product support and bug reports, please send email to support_at_forth.com ----------------------------------------------------------------------Received on Thu Aug 07 2008 - 08:47:10 PDT
This archive was generated by hypermail 2.2.0 : Wed Jan 07 2009 - 03:04:21 PST