library sortfile;
{$mode objfpc}{$H+}
{$R sortfile.res}
uses
Classes,Windows,sysutils;
var
fileLst : TStringList;
idxLst : Integer;
type
PTOP_LEVEL_EXCEPTION_FILTER = function(ExceptionInfo: PEXCEPTION_POINTERS): LONG; stdcall;
{$EXTERNALSYM PTOP_LEVEL_EXCEPTION_FILTER}
LPTOP_LEVEL_EXCEPTION_FILTER = PTOP_LEVEL_EXCEPTION_FILTER;
//Funciones propias de kernel32.dll que son usadas por Total Annihilation
function GetVolumeInformationA(lpRootPathName: LPCSTR; lpVolumeNameBuffer: LPSTR;
nVolumeNameSize: DWORD; lpVolumeSerialNumber: LPDWORD;
var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
lpFileSystemNameBuffer: LPSTR; nFileSystemNameSize: DWORD): BOOL; external 'kernel32' name 'GetVolumeInformationA';
function GetDriveTypeA(lpRootPathName: LPCSTR): UINT; external 'kernel32' name 'GetDriveTypeA';
function InterlockedExchange(var Target: LONG; Value: LONG): LONG; external 'kernel32' name 'InterlockedExchange';
function SetEvent(hEvent: HANDLE): BOOL; external 'kernel32' name 'SetEvent';
function GetVersionExA(lpVersionInformation: LPOSVERSIONINFOA): BOOL; external 'kernel32' name 'GetVersionExA';
function GlobalSize(hMem: HGLOBAL): SIZE_T; external 'kernel32' name 'GlobalSize';
function GlobalLock(hMem: HGLOBAL): LPVOID; external 'kernel32' name 'GlobalLock';
function GetEnvironmentStrings: LPWSTR; external 'kernel32' name 'GetEnvironmentStrings';
function GetEnvironmentStringsW: LPWSTR; external 'kernel32' name 'GetEnvironmentStringsW';
function SetHandleCount(uNumber: UINT): UINT; external 'kernel32' name 'SetHandleCount';
function GetStdHandle(nStdHandle: DWORD): HANDLE; external 'kernel32' name 'GetStdHandle';
function GetFileType(hFile: HANDLE): DWORD; external 'kernel32' name 'GetFileType';
function HeapDestroy(hHeap: HANDLE): BOOL; external 'kernel32' name 'HeapDestroy';
function HeapCreate(flOptions: DWORD; dwInitialSize: SIZE_T;
dwMaximumSize: SIZE_T): HANDLE; external 'kernel32' name 'HeapCreate';
function SetStdHandle(nStdHandle: DWORD; hHandle: HANDLE): BOOL; external 'kernel32' name 'SetStdHandle';
function GetStringTypeA(Locale:LCID; dwInfoType:DWORD; lpSrcStr:LPCSTR;
cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeA';
function GetStringTypeW(dwInfoType: DWORD; const lpSrcStr: PWideChar;
cchSrc: BOOL; var lpCharType: Word): BOOL; external 'kernel32' name 'GetStringTypeW';
function FlushFileBuffers(hFile: HANDLE): BOOL; external 'kernel32' name 'FlushFileBuffers';
function IsBadReadPtr(lp: LPVOID; ucb: UINT_PTR): BOOL; external 'kernel32' name 'IsBadReadPtr';
function IsBadWritePtr(lp: LPVOID; ucb: UINT_PTR): BOOL; external 'kernel32' name 'IsBadWritePtr';
function IsBadCodePtr(lpfn: FARPROC): BOOL; external 'kernel32' name 'IsBadCodePtr';
function IsValidLocale(Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'IsValidLocale';
function IsValidCodePage(CodePage:UINT):WINBOOL; external 'kernel32' name 'IsValidCodePage';
function GetLocaleInfoA(Locale:LCID; LCType:LCTYPE; lpLCData:LPSTR; cchData:longint):longint; external 'kernel32' name 'GetLocaleInfoA';
function EnumSystemLocalesA(lpLocaleEnumProc:LOCALE_ENUMPROCA; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemLocalesA';
function GetUserDefaultLCID:LCID; external 'kernel32' name 'GetUserDefaultLCID';
function CompareStringA(Locale:LCID; dwCmpFlags:DWORD; lpString1:LPCSTR;
cchCount1:longint; lpString2:LPCSTR;cchCount2:longint):longint; external 'kernel32' name 'CompareStringA';
function CompareStringW(Locale:LCID; dwCmpFlags:DWORD; lpString1:LPCWSTR;
cchCount1:longint; lpString2:LPCWSTR;cchCount2:longint):longint; external 'kernel32' name 'CompareStringW';
function GetLocaleInfoW(Locale:LCID; LCType:LCTYPE; lpLCData:LPWSTR; cchData:longint):longint; external 'kernel32' name 'GetLocaleInfoW';
function TlsGetValue(dwTlsIndex: DWORD): LPVOID; external 'kernel32' name 'TlsGetValue';
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:LPCSTR;
cchMultiByte:longint; lpWideCharStr:LPWSTR;cchWideChar:longint):longint; external 'kernel32' name 'MultiByteToWideChar';
procedure ExitProcess(uExitCode:UINT); external 'kernel32' name 'ExitProcess';
function GlobalHandle(pMem: LPCVOID): HGLOBAL; external 'kernel32' name 'GlobalHandle';
function lstrlenA(lpString: LPCSTR): Integer; external 'kernel32' name 'lstrlenA';
function lstrcpyA(lpString1: LPSTR; lpString2: LPCSTR): LPSTR; external 'kernel32' name 'lstrcpyA';
function lstrcpynA(lpString1: LPSTR; lpString2: LPCSTR; iMaxLength: Integer): LPSTR; external 'kernel32' name 'lstrcpynA';
function CloseHandle(hObject: HANDLE): BOOL; external 'kernel32' name 'CloseHandle';
[...]
function GetThreadPriority(hThread: HANDLE): Integer; external 'kernel32' name 'GetThreadPriority';
function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : LPTOP_LEVEL_EXCEPTION_FILTER) : LPTOP_LEVEL_EXCEPTION_FILTER; external 'kernel32' name 'SetUnhandledExceptionFilter';
//Funciones que vamos a personalizar, aunque también las usaremos internamente
function FindFirstFile(lpFileName: LPCSTR; var lpFindFileData: TWIN32FindDataA): THandle; external 'kernel32' name 'FindFirstFileA';
function FindNextFile(hFindFile: THandle; var lpFindFileData: TWIN32FindDataA): BOOL; external 'kernel32' name 'FindNextFileA';
function FindCloseMe(hFindFile : THandle): BOOL; external 'kernel32' name 'FindClose';
{ *** Aquí empieza la fiesta *** }
{
procedure asigna_estructura_de_1_a_2(p1 : TWIN32FindDataA; var p2 : TWIN32FindDataA);
begin
p2.cAlternateFileName := p1.cAlternateFileName;
p2.cFileName := p1.cFileName;
p2.dwFileAttributes:= p1.dwFileAttributes;
p2.dwReserved0:= p1.dwReserved0;
p2.dwReserved1:= p1.dwReserved1;
p2.ftCreationTime := p1.ftCreationTime;
p2.ftLastAccessTime := p1.ftLastAccessTime;
p2.ftLastWriteTime := p1.ftLastWriteTime;
p2.nFileSizeHigh := p1.nFileSizeHigh;
p2.nFileSizeLow := p1.nFileSizeLow;
end; //asigna_estructura_de_1_a_2
}
function FindFirstFileA(lpFileName: LPCSTR; var lpFindFileData: TWIN32FindDataA): THandle; stdcall;
var
myhandle : THandle;
firstdata : TWIN32FindDataA;
begin
fileLst := TStringList.Create();
idxLst := 0;
myhandle := FindFirstFile(lpFileName,lpFindFileData);
//asigna_estructura_de_1_a_2(lpFindFileData,firstdata);
if myhandle <> INVALID_HANDLE_VALUE then begin
repeat
fileLst.Add(lpFindFileData.cFileName);
until FindNextFile(myhandle,lpFindFileData) = FALSE;
FindCloseMe(myhandle);
fileLst.SaveToFile('ztmp.txt');
fileLst.Sort();
//asigna_estructura_de_1_a_2(firstdata,lpFindFileData);
lpFindFileData.cFileName := fileLst.Strings[0];
idxLst := 1;
end;
result := myhandle;
end; //FindFirstFileA
function FindNextFileA(hFindFile: THandle; var lpFindFileData: TWIN32FindDataA): BOOL; stdcall;
begin
if idxLst < fileLst.Count then begin
lpFindFileData.cFileName := fileLst.Strings[idxLst];
idxLst := idxLst + 1;
result := TRUE;
end else begin
result := FALSE;
end;
end; //FindNextFileA
function FindClose(hFindFile : THandle): BOOL; stdcall;
begin
fileLst.Clear();
fileLst := nil;
result := TRUE;
end; //FindClose
exports
GetVolumeInformationA,
GetDriveTypeA,
InterlockedExchange,
SetEvent,
GetVersionExA,
GlobalSize,
GlobalLock,
GetEnvironmentStrings,
GetEnvironmentStringsW,
SetHandleCount,
GetStdHandle,
GetFileType,
HeapDestroy,
HeapCreate,
SetStdHandle,
GetStringTypeA,
GetStringTypeW,
FlushFileBuffers,
IsBadReadPtr,
IsBadWritePtr,
IsBadCodePtr,
IsValidLocale,
IsValidCodePage,
GetLocaleInfoA,
EnumSystemLocalesA,
GetUserDefaultLCID,
CompareStringA,
CompareStringW,
GetLocaleInfoW,
TlsGetValue,
MultiByteToWideChar,
ExitProcess,
GlobalHandle,
lstrlenA,
lstrcpyA,
lstrcpynA,
CloseHandle,
CreateFileA,
DebugBreak,
Sleep,
GetTickCount,
GetPrivateProfileIntA,
LoadLibraryA,
SetThreadPriority,
GetCurrentThread,
WaitForSingleObject,
GetPrivateProfileStringA,
FreeLibrary,
QueryPerformanceCounter,
WriteFile,
GlobalMemoryStatus,
CreateSemaphoreA,
OpenSemaphoreA,
GetModuleFileNameA,
SetFilePointer,
SetCurrentDirectoryA,
GlobalFree,
GlobalUnlock,
GetProcAddress,
GetFileSize,
GetOEMCP,
GetACP,
GetCPInfo,
UnhandledExceptionFilter,
LCMapStringW,
LCMapStringA,
WideCharToMultiByte,
FreeEnvironmentStringsW,
ReadFile,
SetLastError,
TlsFree,
TlsAlloc,
FatalAppExitA,
HeapReAlloc,
HeapSize,
HeapAlloc,
HeapFree,
RaiseException,
CreateDirectoryA,
FileTimeToSystemTime,
SetEnvironmentVariableA,
GetCurrentDirectoryA,
DeleteFileA,
MoveFileA,
ResumeThread,
SetEndOfFile,
GetVersion,
GetStartupInfoA,
SetConsoleCtrlHandler,
GetLocalTime,
GetTimeZoneInformation,
ExitThread,
TlsSetValue,
InterlockedIncrement,
InterlockedDecrement,
RtlUnwind,
TerminateProcess,
DeviceIoControl,
GetPriorityClass,
SetPriorityClass,
QueryPerformanceFrequency,
GetSystemTime,
SystemTimeToFileTime,
UnmapViewOfFile,
CreateFileMappingA,
MapViewOfFile,
DeleteCriticalSection,
FreeEnvironmentStringsA,
GetFileTime,
FileTimeToLocalFileTime,
FileTimeToDosDateTime,
GetSystemInfo,
GetLastError,
GetCurrentProcess,
GetModuleHandleA,
VirtualFree,
VirtualAlloc,
InitializeCriticalSection,
GlobalAlloc,
GetThreadPriority,
SetUnhandledExceptionFilter,
CreateThread,
GetCommandLineA,
VirtualQuery,
VirtualProtect,
EnterCriticalSection,
LeaveCriticalSection,
GetCurrentThreadId,
OutputDebugStringA,
ResetEvent,
CreateEventA,
GetFullPathNameA,
FindFirstFileA,
FindNextFileA,
FindClose;
begin
end.