Текущий архив: 2008.03.16;
Скачать: CL | DM;

Вниз

аналог ExtractFIlePath на winapi   Найти похожие ветки 

← →
i   (2008-02-15 19:01) [0]

нужно написать аналог ExtractFilePath на winapi. т.е. везде pchar вместо string:

procedure GetFileNamePath(var AFN: PChar);

можете помочь кодом?

---

← →
palva ©   (2008-02-15 19:46) [1]

> нужно написать аналог
Объясняйте аналогию подробнее. Вы хотите вместо функции написать процедуру.
> var AFN: PChar
Почему var - вы собираетесь возвращать указатель на статическую память?
> аналог ExtractFilePath на winapi
Какие API-функции вы собираетесь использовать?

---

← →
i   (2008-02-15 19:57) [2]

всё равно как сделать ExtractFilePath, лишь бы не использовать явно или косвенно sysutils и strings.

>Почему var - вы собираетесь возвращать указатель на статическую память?
строку pchar создаю и убиваю за рамками процедуры

>Какие API-функции вы собираетесь использовать?
любые которые идут в модуле windows

---

← →
easy ©   (2008-02-15 20:29) [3]

носи - не стаптывай. =)

program extractfilepathproject;

{$APPTYPE CONSOLE}

type
{ MultiByte Character Set (MBCS) byte type }
 TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);

{ System Locale information record }
 TSysLocale = packed record
   DefaultLCID: Integer;
   PriLangID: Integer;
   SubLangID: Integer;
   FarEast: Boolean;
   MiddleEast: Boolean;
 end;

var
 LeadBytes: set of Char = [];
 SysLocale: TSysLocale;

const
 PathDelim  = "\";
 DriveDelim = ":";

function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType;
var
 I: Integer;
begin
 Result := mbSingleByte;
 if (P = nil) or (P[Index] = #$0) then Exit;
 if (Index = 0) then
 begin
   if P[0] in LeadBytes then Result := mbLeadByte;
 end
 else
 begin
   I := Index - 1;
   while (I >= 0) and (P[I] in LeadBytes) do Dec(I);
   if ((Index - I) mod 2) = 0 then Result := mbTrailByte
   else if P[Index] in LeadBytes then Result := mbLeadByte;
 end;
end;

function ByteType(const S: string; Index: Integer): TMbcsByteType;
begin
 Result := mbSingleByte;
 if SysLocale.FarEast then
   Result := ByteTypeTest(PChar(S), Index-1);
end;

function StrScan(const Str: PChar; Chr: Char): PChar;
begin
 Result := Str;
 while Result^ <> Chr do
 begin
   if Result^ = #0 then
   begin
     Result := nil;
     Exit;
   end;
   Inc(Result);
 end;
end;

function LastDelimiter(const Delimiters, S: string): Integer;
var
 P: PChar;
begin
 Result := Length(S);
 P := PChar(Delimiters);
 while Result > 0 do
 begin
   if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then
     if (ByteType(S, Result) = mbTrailByte) then
       Dec(Result)
     else
       Exit;
   Dec(Result);
 end;
end;

function ExtractFilePath(const FileName: string): string;
var
 I: Integer;
begin
 I := LastDelimiter(PathDelim + DriveDelim, FileName);
 Result := Copy(FileName, 1, I);
end;

begin
 { TODO -oUser -cConsole Main : Insert code here }
 writeln(extractfilepath(paramstr(0)));
 writeln("Press ENTER");
 readln;
end.

---

← →
guav ©   (2008-02-15 20:29) [4]

PathRemoveFileSpec из shlwapi.dll

---

← →
easy ©   (2008-02-15 20:30) [5]

даже windows ненадо

---

← →
{RASkov} ©   (2008-02-15 20:35) [6]

> [2] i   (15.02.08 19:57)

Как еще 1 вариант:
program Project1;
//uses Dialogs;

const PathDelim  = "\";

function LastDelimiter(const Delim: Char; const S: String): Integer;
begin
 Result := Length(S);
 while Result > 0 do
  if S[Result]<>Delim then Dec(Result) else  Exit;
end;

function ExtractFilePath(const AStr: String): String;
begin
 Result:=Copy(AStr, 1, LastDelimiter(PathDelim, AStr));
end;

begin
 //ShowMessage(ExtractFilePath(ParamStr(0)));
end.
Только для "винды" )

---

← →
easy ©   (2008-02-15 20:44) [7]

простите, стринг нельзя упоминать..
program extractfilepathproject;

{$APPTYPE CONSOLE}

type
{ MultiByte Character Set (MBCS) byte type }
 TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);

{ System Locale information record }
 TSysLocale = packed record
   DefaultLCID: Integer;
   PriLangID: Integer;
   SubLangID: Integer;
   FarEast: Boolean;
   MiddleEast: Boolean;
 end;

var
 LeadBytes: set of Char = [];
 SysLocale: TSysLocale;

const
 PathDelim  = "\";
 DriveDelim = ":";

function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType;
var
 I: Integer;
begin
 Result := mbSingleByte;
 if (P = nil) or (P[Index] = #$0) then Exit;
 if (Index = 0) then
 begin
   if P[0] in LeadBytes then Result := mbLeadByte;
 end
 else
 begin
   I := Index - 1;
   while (I >= 0) and (P[I] in LeadBytes) do Dec(I);
   if ((Index - I) mod 2) = 0 then Result := mbTrailByte
   else if P[Index] in LeadBytes then Result := mbLeadByte;
 end;
end;

function ByteType(const S: PChar; Index: Integer): TMbcsByteType;
begin
 Result := mbSingleByte;
 if SysLocale.FarEast then
   Result := ByteTypeTest(S, Index-1);
end;

function StrScan(const Str: PChar; Chr: Char): PChar;
begin
 Result := Str;
 while Result^ <> Chr do
 begin
   if Result^ = #0 then
   begin
     Result := nil;
     Exit;
   end;
   Inc(Result);
 end;
end;

function LastDelimiter(const Delimiters, S: PChar): Integer;
var
 P: PChar;
begin
 Result := Length(S);
 P := PChar(Delimiters);
 while Result > 0 do
 begin
   if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then
     if (ByteType(S, Result) = mbTrailByte) then
       Dec(Result)
     else
       Exit;
   Dec(Result);
 end;
end;

function ExtractFilePath(const FileName: PChar): string;
var
 I: Integer;
begin
 I := LastDelimiter(PathDelim + DriveDelim, FileName);
 Result := Copy(FileName, 1, I);
end;

begin
 { TODO -oUser -cConsole Main : Insert code here }
 writeln(extractfilepath(PChar(paramstr(0))));
 writeln("Press ENTER");
 readln;
end.

---

← →
easy ©   (2008-02-15 20:49) [8]

program Project1;
{$APPTYPE CONSOLE}

const PathDelim  = "\";

function LastDelimiter(const Delim: Char; const S: PChar): Integer;
begin
Result := Length(S);
while Result > 0 do
 if S[Result]<>Delim then Dec(Result) else  Exit;
end;

function ExtractFilePath(const AStr: PChar): String;
begin
Result:=Copy(AStr, 1, LastDelimiter(PathDelim, AStr));
end;

begin
 { TODO -oUser -cConsole Main : Insert code here }
 writeln(extractfilepath(PChar(paramstr(0))));
 writeln("Press ENTER");
 readln;
end.

> {RASkov} © (15.02.08 20:35) [6]

!

---

← →
{RASkov} ©   (2008-02-15 20:56) [9]

> [7] easy ©   (15.02.08 20:44)
> простите, стринг нельзя упоминать..


> лишь бы не использовать явно или косвенно sysutils и strings.

Вообще-то про String ничего небыло сказано :)

---

← →
easy ©   (2008-02-15 20:58) [10]

> i (15.02.08 19:01) [0]
> нужно написать аналог ExtractFilePath на winapi. т.е. везде
> pchar вместо string:

---

← →
{RASkov} ©   (2008-02-15 21:01) [11]

> [10] easy ©   (15.02.08 20:58)

Согласен, но вот в [8] получился аналог ExtractFileDir а не Path
:) Пусть будет домашним заданием)

---

← →
Игорь Шевченко ©   (2008-02-15 21:16) [12]

program ExtractFilePath;

{$APPTYPE CONSOLE}

uses
 Windows;

var
 PathName: array[0..MAX_PATH] of char;
 FileName: PChar;
begin
 GetFullPathName (Pchar(ParamStr(0)), SizeOf(PathName), PathName, FileName);
 FileName^ := #0;
 writeln(PathName);
end.

---

← →
i   (2008-02-15 21:17) [13]

кул, всем спасибо!!!

---

← →
palva ©   (2008-02-15 21:20) [14]

О чем ветка ваще? Перечитайте [0] и [2]
1. Нужна процедура, а не функция. Причем с var параметром типа PChar.
2. Обязательно нужно использовать какие-нибудь функции из Windows.pas
3. Зачем столько кода для простейшей вещи?

---

← →
i   (2008-02-15 21:25) [15]

> <Цитата>
>
> palva ©   (15.02.08 21:20) [14]


всё ок, я просто не сильно формализовал вопрос, сорри.

всем большое спасибо!

---

Страницы: 1 вся ветка

Текущий архив: 2008.03.16;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.015 c