You simply drop the files on the window and click 'Fix'.Simple. :)
It's deliberatly very basic and the renaming rules should be easy to modify and customize for an average or beginner fb coder. Users should modify the PathCleanup function to suit your own needs.
I recommend that you play with it first on a backup of some downloaded media files first since it changes filenames at the drop of of a hat and has precious few saftey checks. In short its very powerful and and with that comes risks for sloppy users.... USE AT YOUR OWN RISK.
The full radasm project including exe and source files are also available at:
http://www.putlocker.com/file/2335520D976C564B
This app is still in development and I will continue to post updates as and when I get the time.
With much love for the FB developers .. Bob.
Compile the dialog resource file with
Code: Select all
GoRC /r "FixFilename.rc"Code: Select all
fbc -w 3 -s gui -x "FixFilename.exe" "FixFilename.bas" "FixFilename.res"Code: Select all
''
''FixFilename
''
#include once "FixFilename.bi"
hInstance = GetModuleHandle(0)
DialogBoxParam(GetModuleHandle(NULL),CAST( any ptr,IDD_DLG1), NULL, @DlgProc, NULL)
ExitProcess(0)
'''
''' Program end
'''
function DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
dim as long id, event
dim CNT as integer
select case uMsg
case WM_COMMAND
id=loword(wParam)
event=hiword(wParam)
select case id
case IDC_CHKNUM
nChkNumbers = IsDlgButtonChecked(hWin,IDC_CHKNUM)
case IDC_BTN_FIX
dim LBCOUNT as integer
LBCOUNT = SendDlgItemMessage(hWin,IDC_LST_INPUT,LB_GETCOUNT,0,0)
If LBCOUNT <> LB_ERR then
for curr as integer = 0 to LBCOUNT-1
SendDlgItemMessage(hWin,IDC_LST_INPUT,LB_GETTEXT,curr,STRPTR(FN_FROM))
SendDlgItemMessage(hWin,IDC_LST_OUTPUT,LB_GETTEXT,curr,STRPTR(FN_TO))
if FN_FROM <> FN_TO then ' No point
if IsFile(STRPTR(FN_TO)) then ' New filename already exists as a file
if lcase(FN_FROM) = lcase(FN_TO) then ' check if just a recasing prob
MoveFile(strptr(FN_FROM),strptr(FN_TO)) ' if so do it anyay
else'ask if overwrite
' dim as string sss = "Cannot rename to " & FN_TO
' dim as uinteger mbres = MessageBox(hWin,STRPTR(sss),"Output filename already exists!",MB_YESNO OR MB_ICONERROR)
' if mbres = IDYES then
MoveFile(strptr(FN_FROM),strptr(FN_TO))
endif
else
MoveFile(strptr(FN_FROM),strptr(FN_TO))
endif
endif
next
endif
case IDC_BTN_CLEAR
SendDlgItemMessage(hWin,IDC_LST_INPUT,LB_RESETCONTENT,0,0)
SendDlgItemMessage(hWin,IDC_LST_OUTPUT,LB_RESETCONTENT,0,0)
case IDC_BTN_REMOVE
dim LBSELECTED as integer
LBSELECTED = SendDlgItemMessage(hWin,IDC_LST_INPUT,LB_GETCURSEL,0,0)
IF LBSELECTED <> LB_ERR THEN
SendDlgItemMessage(hWin,IDC_LST_INPUT,LB_DELETESTRING,LBSELECTED,0)
SendDlgItemMessage(hWin,IDC_LST_OUTPUT,LB_DELETESTRING,LBSELECTED,0)
ENDIF
case IDC_BTN_EXIT
PostMessage(hWin,WM_CLOSE,0,0)
end select
case WM_DROPFILES
nChkNumbers = IsDlgButtonChecked(hWin,IDC_CHKNUM)
CNT = (DragQueryFile(CAST(any ptr,wParam),CINT(-1),0,0)) ' Get Number Of dropped filles
IF CNT THEN ' > 0?
FOR x as integer = 0 to CNT-1
dim temp as integer = DragQueryFile(CAST(any ptr,wParam),x,STRPTR(FN),MAX_PATH)
'SetWindowText(hWin,@FilenameIn(0))
if IsFile(STRPTR(FN)) then
SendDlgItemMessage(hWin,IDC_LST_INPUT,LB_ADDSTRING,0,STRPTR(FN)) ' If valid file spit it to the lb
FN = PathCleanup(FN)
SendDlgItemMessage(hWin,IDC_LST_OUTPUT,LB_ADDSTRING,0,STRPTR(FN)) ' If valid file spit it to the lb
endif
NEXT
ENDIF
case WM_INITDIALOG
' CAST(HICON,CNT) = LoadIcon(hInstance,500)
' SendMessage(hWin,WM_SETICON,ICON_BIG,CNT)
hWinStatus = GetDlgItem(hWin,IDC_STATUS) ' Get Win Handle for status
'SendDlgItemMessage(hWin,IDC_CHKNUM,BM_SETCHECK,BST_CHECKED,0)
case WM_CLOSE
EndDialog(hWin, 0)
case WM_SIZE
dim rc as RECT
dim x as integer
dim y as integer
SendMessage(hWinStatus,WM_SIZE,0,0) ' Move+size status win
GetWindowRect(hWinStatus,@rc) ' Get Statusbar Hieght
rc.bottom -= rc.top
x = rc.bottom ' Save it
GetClientRect(hWin,@rc) ' Get dlg client size
rc.bottom -= x+2 ' without over lapping status
' Buttons are stacked here
x=rc.right - (BWIDTH+1) : y=rc.bottom - BHIEGHT+1
MoveDlgItem(hWin,IDC_BTN_EXIT,x,y,BWIDTH,BHIEGHT) : y -= BHIEGHT
MoveDlgItem(hWin,IDC_BTN_FIX,x,y,BWIDTH,BHIEGHT) : y -= BHIEGHT
MoveDlgItem(hWin,IDC_BTN_REMOVE,x,y,BWIDTH,BHIEGHT) : y -= BHIEGHT
MoveDlgItem(hWin,IDC_BTN_CLEAR,x,y,BWIDTH,BHIEGHT) : y -= BHIEGHT
MoveDlgItem(hWin,IDC_CHKNUM,x,y,BWIDTH,BHIEGHT) : y -= BHIEGHT
' Listboxes are resized here
rc.right -= BWIDTH ' Adjust rect for buttons
rc.right /= 2 ' Half width
MoveDlgItem(hWin,IDC_LST_INPUT,0,0,rc.right,rc.bottom)
MoveDlgItem(hWin,IDC_LST_OUTPUT,rc.right,0,rc.right,rc.bottom)
InvalidateRect(hWin,0,TRUE) ' Repaint all resized ctrls
case else
return FALSE
end select
return TRUE
end function
sub SetStatusbar(Text as string)
SendMessage(hWinStatus,SB_SETTEXT,0,STRPTR(Text))
end sub
function MoveDlgItem(hWin as HWND, nDlgId as uinteger,x as integer,y as integer,w as integer,h as integer) as integer
hWin = GetDlgItem(hWin,nDlgId) ' get dg item handle reusing hwin
if IsWindow(hWin) then
MoveWindow(hWin,x,y,w,h,FALSE)
return TRUE
endif
return FALSE
end function
function IsFile(lpString as byte ptr) as uinteger
dim filehandle as HANDLE
dim filesize as uinteger
filehandle = CreateFile(lpString,GENERIC_READ,FILE_SHARE_READ,0,OPEN_EXISTING,0,0)
if filehandle = 0 or filehandle = -1 then
return FALSE
else
CloseHandle(filehandle)
return TRUE
endif
end function
Code: Select all
#include once "windows.bi"
#include once "win\commctrl.bi"
#include once "win\shellapi.bi"
dim shared as integer nChkNumbers
#include once "StringOps.bas" ' <---- Path and string manipulation instructions
' ------- DLG CTRLS --------
#define IDD_DLG1 1000
#define IDC_BTN_EXIT 1001
#define IDC_LST_INPUT 1002
#define IDC_LST_OUTPUT 1003
#define IDC_BTN_FIX 1004
#define IDC_BTN_REMOVE 1005
#define IDC_BTN_CLEAR 1006
#define IDC_STATUS 1007
#define IDC_CHKNUM 1008
#define BWIDTH 100
#define BHIEGHT 30
declare function DlgProc(byval hWnd as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
declare function MoveDlgItem(hWin as HWND, nDlgId as uinteger,x as integer,y as integer,w as integer,h as integer) as integer
declare function IsFile(lpString as byte ptr) as uinteger
' -------------- DATA ----------------
dim shared hInstance as HINSTANCE
dim shared hWinStatus as HWND
dim shared FilenameIn(MAX_PATH+1) as byte
dim shared FileName as byte ptr = @FilenameIn(0)
dim shared FN as string*MAX_PATH+1
dim shared FN_FROM as string*MAX_PATH+1
dim shared FN_TO as string*MAX_PATH+1
Code: Select all
' this page take from fb forums by
'dodicat
' Post subject: Re: Advanced Search StringInStr
'Unread postPosted: Aug 17, 2013 13:53
declare function PathGetFilename(s As String) as string
declare function PathGetPath(s As String) as string
declare function FilenameRemoveExt(fnonly As String) as string
declare function FilenameGetExt(fnonly As String) as string
declare Function InstringCounter(instring As String,PartString As String,c() as integer) As integer
declare Function Replace(InString As String,ReplaceThis As String,WithThis As String) As String
declare function PathCleanup(s as string) as string
declare function PathCapitalize(s as string) as string
declare Sub split(s_in As String,chars As String,result() As String)
Function Replace(InString As String,ReplaceThis As String,WithThis As String) As String
Dim s As String=InString
var position=Instr(lcase(s),lcase(ReplaceThis))
While position>0
s=Mid(s,1,position-1) & WithThis & Mid(s,position+Len(ReplaceThis))
position=Instr(position+Len(WithThis),lcase(s),lcase(ReplaceThis))
Wend
Replace=s
End Function
Function ReplaceCS(InString As String,ReplaceThis As String,WithThis As String) As String
Dim s As String=InString
var position=Instr(s,ReplaceThis)
While position>0
s=Mid(s,1,position-1) & WithThis & Mid(s,position+Len(ReplaceThis))
position=Instr(position+Len(WithThis),s,ReplaceThis)
Wend
ReplaceCS=s
End Function
function PathGetFilename(s As String) as string
Dim sf As String
if instr(s,"\") then
sf = Mid(s, Instrrev(s, "\") + 1)
else
sf =s
endif
return sf
end function
function PathGetPath(s As String) as string
Dim sf As String
if instr(s,"\") then
dim as integer p = Instrrev(s, "\")
sf = Mid(s,1,p)
endif
return sf
end function
function FilenameGetExt(fnonly As String) as string
Dim sf As String
if instr(fnonly,".") then
dim as integer p = Instrrev(fnonly, ".")
sf = Mid(fnonly,p+1) ' +1 is to ignore the period char....
endif
return sf
end function
function FilenameRemoveExt(fnonly As String) as string
Dim sf As String = fnonly
if instr(fnonly,".") then ' incase of no extention
dim as integer p = Instrrev(fnonly, ".")
sf = Mid(fnonly,1,p-1)
endif
return sf
end function
function PathCleanup(s as string) as string
dim a as string
dim b as string
dim c as string
a=PathGetPath(s) ' Get the path
b=FilenameGetExt(PathGetFilename(s)) ' Get the ext
s=FilenameRemoveExt(PathGetFilename(s)) ' Get the FileName without the ext
' Begin Filename cleanup
s = lcase(s)
' --------- Website name Cleanup -------------------
s = Replace(s,"sockshare","") ' sockshare to blank
s = Replace(s,"putlocker","") ' putlocker to blank
s = Replace(s,"sinistergrin","") ' SinisterGrin to blank
s = Replace(s,"primewire.ag","") ' primewire to blank
s = Replace(s,"ftra","futurama") ' FTRA to Futurama
s = Replace(s,"bob_s","bobs") ' FTRA to Futurama
s = Replace(s,"_20"," ") ' FTRA to Futurama
s = Replace(s," 20"," ") ' FTRA to Futurama
s = Replace(s,"Transformers - The Album - 0","") ' Web addr to spc
s = Replace(s,"Transformers The Album 1","") ' Web addr to spc
' --------- Generic Cleanup -------------------
s = Replace(s,"_"," ") ' underscore to space
s = Replace(s,"-"," ") ' hyhen to space
s = Replace(s,"@"," ") ' act to space
s = Replace(s," .",".") ' spc point to point
s = Replace(s," .",".") ' spc point to point
s = Replace(s," .",".") ' spc point to point
s = Replace(s," .",".") ' spc point to point
s = Replace(s," .",".") ' spc point to point
while instr(s," ") ' remove dbl spcs to 1 space
s = Replace(s," "," ")
wend
' reduntant xtension
s = Replace(s,".avi","")
s = Replace(s,".mp4","")
s = Replace(s,".flv","")
s = Replace(s,".hdtv","")
s = Replace(s,".flac","")
s = Replace(s,"i ll","ill")
s = Replace(s,"don t","dont")
s = Replace(s,"can t","cant")
s = Replace(s,"low ch9","")
numcheck:
s = trim(s) ' Remove any spaces
if nChkNumbers <> 0 then
if s[0]=asc("1") then s = Replace(s,"1",""): goto numcheck
if s[0]=asc("2") then s = Replace(s,"2",""): goto numcheck
if s[0]=asc("3") then s = Replace(s,"3",""): goto numcheck
if s[0]=asc("4") then s = Replace(s,"4",""): goto numcheck
if s[0]=asc("5") then s = Replace(s,"5",""): goto numcheck
if s[0]=asc("6") then s = Replace(s,"6",""): goto numcheck
if s[0]=asc("7") then s = Replace(s,"7",""): goto numcheck
if s[0]=asc("8") then s = Replace(s,"8",""): goto numcheck
if s[0]=asc("9") then s = Replace(s,"9",""): goto numcheck
if s[0]=asc("0") then s = Replace(s,"0",""): goto numcheck
if s[0]=asc(".") then s = Replace(s,".",""): goto numcheck
endif
'---------------------------------------------------------------------------
s = trim(s) ' Remove any spaces
' Rejoin Filename to path + add extension
c = a + s + "."+ b ' Path + Cleaned up fn + period + untouched ext
' Finally capitalize
s = PathCapitalize(c)
return s
end function
function PathCapitalize(s as string) as string
dim b as string
dim Stringlength as uinteger
b = lcase(s) ' Start with all lcase string
Stringlength = LEN(b) ' Get strings length
if Stringlength then
if b[0] > 96 and b[0] < 123 then
b[0] = b[0] - 32 ' First is always made Ucase
'if OR b[x-1] = Asc("/") OR b[x-1] = Asc(" ") then PrevWasSpace = 1
endif
endif
for x as integer = 1 to Stringlength-1
if (b[x] > 96 and b[x] < 123) then
if b[x-1] = Asc("\") or b[x-1] = Asc(" ") or b[x-1] = Asc(":") or b[x-1] = Asc("(") then b[x] = b[x] - 32 ' make Ucase if is char + PrevWasSpace
endif
next
return b
end function
Code: Select all
#define IDD_DLG1 1000
#define IDC_BTN_EXIT 1001
#define IDC_LST_INPUT 1002
#define IDC_LST_OUTPUT 1003
#define IDC_BTN_FIX 1004
#define IDC_BTN_REMOVE 1005
#define IDC_BTN_CLEAR 1006
#define IDC_STATUS 1007
#define IDC_CHKNUM 1008
IDD_DLG1 DIALOGEX 6,6,614,275
CAPTION "Filename Fixer 1.0 beta"
FONT 8,"MS Sans Serif",400,0
STYLE 0x10CF0800
EXSTYLE 0x00000010
BEGIN
CONTROL "Exit",IDC_BTN_EXIT,"Button",0x50010000,410,168,64,19,0x00000000
CONTROL "",IDC_LST_INPUT,"ListBox",0x50310141,42,12,182,172,0x00020010
CONTROL "",IDC_LST_OUTPUT,"ListBox",0x50310141,228,12,182,172,0x00020010
CONTROL "Fix",IDC_BTN_FIX,"Button",0x50010000,410,147,64,19,0x00000000
CONTROL "Remove",IDC_BTN_REMOVE,"Button",0x50010000,410,127,64,19,0x00000000
CONTROL "Clear",IDC_BTN_CLEAR,"Button",0x50010000,410,107,64,19,0x00000000
CONTROL "",IDC_STATUS,"msctls_statusbar32",0x50000103,0,260,614,14,0x00000000
CONTROL "Del Start Nums",IDC_CHKNUM,"Button",0x50010003,412,88,82,17,0x00000000
END