꿈을 찾아서

procedure SetHighPriority(ProcName: String);
var
  Process32: TProcessEntry32;
  H: THandle;
  Next: Boolean;
  pID: DWORD;

begin
  Process32.dwSize:=SizeOf(Process32);
  H:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);

  if Process32First(H, Process32) then begin
    repeat
      Next:=Process32Next(H, Process32);
      if Process32.szExeFile=ProcName then begin
        pID:=OpenProcess(PROCESS_ALL_ACCESS, False, Process32.th32ProcessID);
        if pID<>0 then begin
          ShowMessage('Success: '+ProcName);
          SetPriorityClass(pID, HIGH_PRIORITY_CLASS);
        end
        else ShowMessage('Error : OpenProcess');
      end;
    until not Next;
  end;

  CloseHandle(pID);

  CloseHandle(H);
end;

델파이로 만든 실행파일이 자꾸 바이러스에 감염되었다고 한다.

검색하니 역시나 델파이4~7 만 걸리는 바이러스로 악성코드와 바이러스 둘다 걸리는 특이한 놈이라고 한다

다음은 현승현 님이 작성한 글을 퍼왔다

1. HKLM\Software\Borland\Delphi(4 ~ 7) 의 RootDir 키를 참조하여 델파이의 루트 경로를 구합니다.

2. 1. 에서 구한 경로를 기준으로 \source\rtl\sys\SysConst.pas 파일을 \lib\sysconst.pas 파일로 복사하면서...

소스파일 중간에 바이러스 코드를 집어넣습니다.

3. \lib 폴더의 기존의 SysConst.dcu 파일을 SysConst.bak 파일로 백업합니다.

4. dcc32.exe 이용하여 바이러스 코드가 심어진 sysconst.pas 를 새로 컴파일합니다. (새로운 SysConst.dcu 생성)

5. 새로운 SysConst.dcu 가 생성이 되면 감염된 소스코드 SysConst.pas 파일을 삭제합니다.

이후에 델파이에서 컴파일되는 실행파일들은 모두 바이러스 코드가 심어진 SysConst.dcu 가 적용되면서..

해당 실행파일에 바이러스 코드가 추가되는 방식입니다.

<< 복구방법 >>

델파이 라이브러리를 복구하기 위해서는 \lib 폴더의 SysConst.dcu 파일을 제거 후, SysConst.bak 파일을

SysConst.dcu 파일로 이름을 변경해주거나, \source\rtl\sys 폴더의 SysConst.pas 파일을 새로 컴파일해서...

해당 SysConst.dcu 파일을 덮어쓰면 됩니다.

이게 복잡하다 싶으시면, 델파이 삭제 후~ 재설치하는 방법도 있습니다 :D

감염된 파일 복구 방법은 아직 조금 더 봐야겠지만..

카스퍼스키의 경우, 해당 바이러스 코드 영역(대략 4080 바이트 정도)을 '00' 으로 덮어쓴 후,

바이러스 코드 영역을 호출하는 CALL 명령을 NOP(90) 으로 치환하는 방식이었습니다.

다행히 업체서버가 카스퍼스키라 아무 이상이 없는것 같다. 그러고보니 한번씩 랜덤하게 메모리 에러 나는것도 이놈때문이라 생각된다...현재는... 

Sometimes the simple things are harder than you expected and dbexpress probably comes under that category, it was less express than I had expected but once you figure things out it does work. Some of the problems were my fault while others took time due to the obscur nature of the errors returned by XE and XE2.

If you start by adding the TSQLConnect component, select the MySQL driver and configure your HostName, Database, UserName and Password you can try and connect, you will most likely strike the following error :-

Show Plain Text

Text code

1. DBX Error: Driver could not be properly initialized. Client library may be missing, not installed properly, of the wrong version, or the driver maybe be missing from the system path...

So once you figure out that your missing the libmysql.dll you might try and grab the latest MYSQL C Connector from dev.mysql.com, they are up to version 6.0.2 at the time of writing this, you'll get the same error above. I was getting a more obscure crash before XE2 Update 1 which I didn't note down at the time, that abstract error message took me a while to figure out and was related to the libmysql.dll version.

It would be nice if embarcadero provided a location where you could download the compatible libmysql.dll files that work with dbexpress, it is worth noting that the XE2 read me does come with the following note :-

Show Plain Text

Text code

1. Supported Servers

2. dbExpress

3. ...

4. MySQL 5.1, 5.0.27, 4.1* (Pro/Ent/Ult/Arch) (Driver dbxMYS.dll, Client libmysql.dll)

5.  

6. The following combinations have been tested:

7. LibMySQL.dll (5.1.XX)  DBXMys.dll  MySQL 4.0.XX Server  

8. LibMySQL.dll (5.1.XX)  DBXMys.dll  MySQL 4.0.XX Server  

9. LibMySQL.dll (5.1.XX)  DBXMys.dll  MySQL 5.0.XX Server  

10. LibMySQL.dll (5.1.XX)  DBXMys.dll  MySQL 5.1.XX Server

To get a 5.1.XX compatible DLL you will need to download an achieved mysql complete installation zip and extract the DLL as no compatible versioned MYSQL C Connector package could be downloaded when I looked.

To save you some time I added zip download containing the win32 x86 libmysql.dll for those who wish to download.

This is libmysql.dll version 5.1.59 win32 x86 DLL which I have tested and works with both XE and XE2.

function ChangeFileExt(const FileName, Extension: string): string; 
// 바뀐 문자열만 리턴
// aaa.txt 를 aaa.avi 로 바꿀 경우
// ShowMessage( ChangeFileExt('aaa.txt', '.avi') );
// aaa.avi 로 출력

function FileSize(var F): Integer; 
// 파일 크기

function FileAge(const FileName: string): Integer; 
// 파일을 생성한 날짜

function FileDateToDateTime(FileDate: Integer): TDateTime; 
// 날짜 := FileDateToDateTime( FileAge('FileName') );

function FileSetDate(Handle: Integer; Age: Integer): Integer; overload; 
// 파일을 생성 날짜 변경 

function DateTimeToFileDate(DateTime: TDateTime): Integer; 
// TDateTime형을 Integer형으로 리턴

function FileSetAttr(const FileName: string; Attr: Integer): Integer; 
// 파일의 속성 변경(읽기전용,숨김등..) 

function FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean; 
// True=읽기전용, False=해제 

function DiskSize(Drive: Byte): Int64; 
// 드라이브(디스크) 용량

function DiskFree(Drive: Byte): Int64; 
// 드라이브 남은 용량 
// (Drive: 0=Default Drive, 1=A:, 2=B:, 3=C:, 4=D: 등) 

function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string; 
function AnsiDequotedStr(const S: string; AQuote: Char): string; 
// ShowMessage( AnsiDequotedStr('-ABCDEF-GHIJK$..', '-') ); 
// Result -> ABCDEF 

function AnsiLastChar(const S: string): PChar; 
// 문자열의 마지막 문자 리턴 (2Byte 문자도 가능)

procedure AppendStr(var Dest: string; const S: string); deprecated; 
// Dest := Dest + S;

function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): string; 
// Boolean 값 비교, UseBoolStrs 을 True로 할 경우 문자열로 리턴 

function ByteToCharIndex(const S: string; Index: Integer): Integer; 
// S 문자열 길이를 리턴. S 문자열 길이보다 Index 값이 크면 0을 리턴한다. (그외 Index 값 리턴) 

function ByteToCharLen(const S: string; MaxLen: Integer): Integer; 
// S 문자열 길이보다 MaxLen 값이 크면, S 길이를 리턴한다. (그 외 MaxLen 값 리턴) 

function ByteType(const S: string; Index: Integer): TMbcsByteType; 
// S[Index] 값이 1바이트 값인지, 2바이트(한글) 값의 첫번째 바이트인지, 두번째 바이트인지 판별한다. 

ex) 
var 
 ty: TMbcsByteType; 
begin 
 ty := ByteType('ABC하하012',5); 
 case ty of 
   mbSingleByte: ShowMessage('1byte 문자'); 
   mbLeadByte  : ShowMessage('2byte 문자의 첫번째 바이트'); 
   mbTrailByte : ShowMessage('2byte 문자의 두번째 바이트') 
 end; 
end; 

procedure ForceDeleteDirContent(dir: string);
var i: integer;
sDirectory: string;
sr: TSearchRec;
beginsDirectory := IncludeTrailingPathDelimiter( dir );
i := FindFirst( sDirectory+’*.*’,faAnyFile,sr );
while i = 0 do begin
if ( sr.Attr and faDirectory ) = faDirectory then
DeleteDirectory( sDirectory+sr.Name )
else begin

if not DeleteFile( sDirectory+sr.Name ) then begin
FileSetAttr (sDirectory+sr.Name, 0); { reset all flags }
DeleteFile (sDirectory+sr.Name);
end;

end;
i := FindNext( sr );
end;
FindClose( sr );
end;

시스템종료 메소드는 ExitWindowsEx(EWX_SHUTDOWN,0);

시스템재시작 메소드는 ExitWindowsEx(EWX_REBOOT,0);

시스템강제종료 메소드는 ExitWindowsEx(EWX_FORCE, 0);

시스템 LOG OFF 메소드는 ExitWindowsEx(EWX_LOGOFF, 0);

시스템 PowerOff 메소드는 ExitWindowsEx(EWX_POWEROFF,0);

시스템 종료함수

procedure ShutDown(dwTimeOut : DWord = 0; bForceClose : Boolean = true; bReboot : Boolean = false) ;
var
  PreviosPrivileges: ^TTokenPrivileges;
  TokenPrivileges: TTokenPrivileges;
  hToken: THandle;
  tmpReturnLength: DWord;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then begin
    if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin
      LookupPrivilegeValue(Nil, 'SeShutdownPrivilege', TokenPrivileges.Privileges[0].Luid); 
      TokenPrivileges.PrivilegeCount := 1;
      TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      tmpReturnLength := 0;
      PreviosPrivileges := nil;
      AdjustTokenPrivileges(hToken, False, TokenPrivileges, 0, PreviosPrivileges^, tmpReturnLength);

      if InitiateSystemShutdown(Nil, Nil, dwTimeOut, bForceClose, bReboot) then begin
        TokenPrivileges.Privileges[0].Attributes := 0;
        AdjustTokenPrivileges(hToken, False, TokenPrivileges, 0, PreviosPrivileges^, tmpReturnLength);
      end ;
    end ;
  end
  else
  ExitWindowsEx(EWX_FORCE or EWX_SHUTDOWN or EWX_POWEROFF, 0);
end ; 

OS버전 체크

procedure GetOSVersion;
var
VersionInfo: TOSVersionInfo;
Platform: string;
MajorVersion,MinorVersion,Build: DWORD;
begin
  VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
  GetVersionEx(VersionInfo);
  
  with VersionInfo do
  begin
  case dwPlatformId of
   VER_PLATFORM_WIN32s:        Platform := 'Windows 3x';
   VER_PLATFORM_WIN32_WINDOWS: Platform := 'Windows 95';
   VER_PLATFORM_WIN32_NT:      Platform := 'Windows NT';
  end;
  
  MajorVersion := dwMajorVersion;
  MinorVersion := dwMinorVersion;
  Build := dwBuildNumber;
  end;
end;

메모리 사용정보

uses
  psAPI;

function GetProcessMemorySize(_sProcessName: string; var _nMemSize: Cardinal): Boolean;
var
  l_nWndHandle, l_nProcID, l_nTmpHandle: HWND;
  l_pPMC: PPROCESS_MEMORY_COUNTERS;
  l_pPMCSize: Cardinal;
begin
  l_nWndHandle := FindWindow(nil, PChar(_sProcessName));
  if l_nWndHandle = 0 then
  begin
    Result := False;
    Exit;
  end;
  l_pPMCSize := SizeOf(PROCESS_MEMORY_COUNTERS);
  GetMem(l_pPMC, l_pPMCSize);
  l_pPMC^.cb := l_pPMCSize;
  GetWindowThreadProcessId(l_nWndHandle, @l_nProcID);
  l_nTmpHandle := OpenProcess(PROCESS_ALL_ACCESS, False, l_nProcID);
  if (GetProcessMemoryInfo(l_nTmpHandle, l_pPMC, l_pPMCSize)) then
    _nMemSize := l_pPMC^.WorkingSetSize
  else
    _nMemSize := 0;
  FreeMem(l_pPMC);
  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  l_nSize: Cardinal;
begin
  if (GetProcessMemorySize('Unbenannt - Editor', l_nSize)) then
    ShowMessage('Size: ' + IntToStr(l_nSize) + ' byte')
  else
    ShowMessage('Error');
end;

function GetCPUSpeed: Double;
const
  DelayTime = 500;
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority      := GetThreadPriority(GetCurrentThread);
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  Sleep(10);
  asm
    dw 310Fh
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000 * DelayTime);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(Format('Your CPU speed: %f MHz', [GetCPUSpeed]));
end;