a structure that describes the function)を指しており、構造体の前半8バイトがエントリポイント、次の8バイトが"gpレジスタ"の値を格納するようになっているということでしょうか(関数ポインタがエントリポイントではなくある種の構造体を指すというのはRISC系CPUと共通しています)。
fmCreate = $FFFF;
fmOpenRead = $0000;
fmOpenWrite = $0001;
fmOpenReadWrite = $0002;
fmShareCompat = $0000 platform; // DOS compatibility mode is not portable
fmShareExclusive = $0010;
fmShareDenyWrite = $0020;
fmShareDenyRead = $0030 platform; // write-only not supported on all platforms
fmShareDenyNone = $0040;
constructor TFileStream.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
begin
if Mode = fmCreate then
begin
...
end
else
begin
...
end;
FFileName := AFileName;
end;
inherited Create(FileCreate(AFileName, Rights));
Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
Prevents other processes from opening a file or device if they request delete, read, or write access.=他の処理からは削除、読み込み、書き込みアクセスできない)、dwCreationDispositionはCREATE_ALWAYS(
新しいファイルを作成します。指定したファイルが既に存在している場合、そのファイルを上書きし、既存の属性を消去します。)と、これらの値が固定的に指定される、ということになります。
inherited Create(FileOpen(AFileName, Mode));
const
AccessMode: array[0..2] of LongWord = (
GENERIC_READ,
GENERIC_WRITE,
GENERIC_READ or GENERIC_WRITE);
ShareMode: array[0..4] of LongWord = (
0,
0,
FILE_SHARE_READ,
FILE_SHARE_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE);
...
Result := Integer(CreateFile(PChar(FileName), AccessMode[Mode and 3],
ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0));
ファイルを開きます。指定したファイルが存在していない場合、この関数は失敗します。)が固定的に指定される、ということになります。
procedure HandleStreamSample(const AFilename: String);
var
FileHandle: Integer;
Stream: THandleStream;
begin
FileHandle := CreateFile(PChar(AFilename),GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ,nil,CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL,0);
if FileHandle < 0 then
begin
raise EFCreateError.CreateResFmt(@SFCreateErrorEx,[ExpandFileName(AFileName),
SysErrorMessage(GetLastError)]);
end;
Stream := THandleStream.Create(FileHandle);
try
{ Streamに対する処理 }
finally
Stream.Free;
end;
end;
That's all we can really say,for now)、とのことです。
UNICODE"のように{$IFDEF UNICODE}
// String = UnicodeString (Delphi 2009 or later)
{$ELSE}
// String = AnsiString (Delphi 2007 or earlier)
{$ENDIF}
$IFDEFで判定できません。そこでDelphi 6で導入されたCONDITIONALEXPRESSIONSとRTLVersion/CompilerVersionを組み合わせて判定してみます。{$IF (NOT DEFINED(CONDITIONALEXPRESSIONS)) OR (RTLVersion < 20.0)}
// Delphi 2-5 or 6-2007
{$ELSE}
// Delphi 2009 or later
{$IFEND}
{$IF (DEFINED(CONDITIONALEXPRESSIONS)) AND (RTLVersion >= 20.0)}
{$IF (NOT DEFINED(CONDITIONALEXPRESSIONS)) OR (CompilerVersion < 21.0)}
// Class constructor/destructor is invalid
{$ELSE}
// Class constructor/destructor is valid
{$IFEND}
$IFDEFは$ENDIFで閉じますが、$IFは$IFENDで閉じる、という点に注意が必要です。
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\SystemのEnableLUA(DWORD値)が0かどうかで判断できます(0はUAC無効、1はUAC有効)。一方でUACが有効のときにそのプロセスが管理者権限に昇格しているかどうかはOpenProcessToken (ja)でカレントプロセスのハンドルからアクセストークンを取得し、GetTokenInformation (ja)でTokenInformationClassにTokenElevationを指定して取得したTOKEN_ELEVATION構造体のTokenIsElevatedが0かどうかで判断できます(0は昇格していない、非0は昇格している)。{$IF (NOT DEFINED(CONDITIONALEXPRESSIONS)) OR (RTLVersion < 20.0)}
type
TTokenInformationClass = (TokenUser = 1,
TokenGroups,
TokenPrivileges,
TokenOwner,
TokenPrimaryGroup,
TokenDefaultDacl,
TokenSource,
TokenType,
TokenImpersonationLevel,
TokenStatistics,
TokenRestrictedSids,
TokenSessionId,
TokenGroupsAndPrivileges,
TokenSessionReference,
TokenSandBoxInert,
TokenAuditPolicy,
TokenOrigin,
TokenElevationType,
TokenLinkedToken,
TokenElevation,
TokenHasRestrictions,
TokenAccessInformation,
TokenVirtualizationAllowed,
TokenVirtualizationEnabled,
TokenIntegrityLevel,
TokenUIAccess,
TokenMandatoryPolicy,
TokenLogonSid,
MaxTokenInfoClass);
{$EXTERNALSYM TTokenInformationClass}
PTokenElevation = ^TTokenElevation;
_TOKEN_ELEVATION = record
TokenIsElevated: DWORD;
end;
{$EXTERNALSYM _TOKEN_ELEVATION}
TTokenElevation = _TOKEN_ELEVATION;
TOKEN_ELEVATION = _TOKEN_ELEVATION;
{$EXTERNALSYM TOKEN_ELEVATION}
function GetTokenInformation(TokenHandle: THandle;
TokenInformationClass: TTokenInformationClass;
TokenInformation: Pointer;
TokenInformationLength: DWORD;
var ReturnLength: DWORD): BOOL; stdcall;
external advapi32 name 'GetTokenInformation';
{$EXTERNALSYM GetTokenInformation}
{$IFEND}
function IsProcessTokenElevated(ProcessHandle: THandle): Boolean;
var
TokenHandle: THandle;
TE: TOKEN_ELEVATION;
dwLength: DWORD;
begin
Result := False;
if OpenProcessToken(ProcessHandle,TOKEN_QUERY,TokenHandle) = False then
begin
Exit;
end;
try
if GetTokenInformation(TokenHandle,TokenElevation,
@TE,SizeOf(TE),dwLength) = False then
begin
Exit;
end;
finally
CloseHandle(TokenHandle);
end;
Result := (TE.TokenIsElevated <> 0);
end;
type
TUACStatus = (usNoUAC, // UAC is not implemented
usUACDisabled, // UAC is disabled
usUACEnabled, // UAC is enabled
usUACRunAsAdmin); // UAC is enabled and process token is elevated
function GetUACStatus: TUACStatus;
var
ReadValue: Integer;
begin
Result := usNoUAC;
if CheckWin32Version(6,0) = False then
begin
// Windows 2000 or XP: UAC is not implemented
Exit;
end;
with TRegistry.Create do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly('\Software\Microsoft\Windows\CurrentVersion\Policies\System') = False then
begin
raise ERegistryException.Create('Error: Cannot open registry key.');
end;
try
ReadValue := ReadInteger('EnableLUA');
if ReadValue = 0 then
begin
Result := usUACDisabled;
end
else
begin
Result := usUACEnabled;
end;
finally
CloseKey;
end;
finally
Free;
end;
end;
if Result = usUACEnabled then
begin
if IsProcessTokenElevated(GetCurrentProcess) = True then
begin
Result := usUACRunAsAdmin;
end;
end;
end;
procedure TForm2.FormShow(Sender: TObject);
begin
Close;
end;
procedure TCustomForm.Close;
var
CloseAction: TCloseAction;
begin
if fsModal in FFormState then
ModalResult := mrCancel
else
...
function TCustomForm.ShowModal: Integer;
...
try
Show;
try
SendMessage(Handle, CM_ACTIVATE, 0, 0);
ModalResult := 0;
repeat
Application.HandleMessage;
if Application.Terminated then ModalResult := mrCancel else
if ModalResult <> 0 then CloseModal;
until ModalResult <> 0;
Result := ModalResult;
SendMessage(Handle, CM_DEACTIVATE, 0, 0);
if GetActiveWindow <> Handle then ActiveWindow := 0;
finally
Hide;
end;
...
end;
ModalResult <> 0"という終了条件を満たさないためです。procedure TForm2.FormShow(Sender: TObject);
begin
PostMessage(Handle,WM_CLOSE,0,0);
end;
I am excited to announce that I have joined Embaracadero’s next gen frameworks team leading a very exciting project.
I am working on a very exciting next generation App Development project that will go beyond what the KSDev products were providing. It is safe to say that similar functionality of these frameworks will be made available in future Embarcadero development products. I believe it will be well worth the wait.