строки

 uses Dos;
 var s,Dsk : string;
     Dir:DirStr;  FlNm:NameStr; FlExt :ExtStr;
begin
 writeln('File name :'); readln(s);
 s := FExpand(s);
 FSplit(s,Dir, FlNm, FlExt);
 Dsk := Dir[1];  
 writeln('Dir=', DIr, ', Disk=', Dsk, ', FileName=', FlNm, ', ext=', FlExt);
 readln;
end.

var s, FlNm, FlExt: string; Dsk: string[1];
     t: integer;
begin 
 readln(s);
 if length(s)=0 then 
 begin writeln('пустая строка!'); readln; halt;
 end;
 Dsk := s[1]; {первый символ - диск. можно еще проверить, чтоб второй был : и 3-й \ }
 FlNm :=''; FlExt :=''; t:= length(s); 
 if (pos('.', s)>0) then 
 {есть смысл с конца строки поискать расширение, а потом и имя, если хоть одна точка и \ есть}
   while (t>=1) and (s[t]<>'.') do
   begin
      FlExt := s[t]+FlExt ; t := t -1;
   end;
 
  if pos('\', s)>0 then
  begin
    if t<>length(s) then t := t-1;
    while (t>=1) and (s[t]<>'\') do
    begin FlNm := s[t]+FlNm; t := t-1;
    end;
  end;
 writeln('Disk=', Dsk, ', FileName=', FlNm, ', ext=', FlExt);
 readln;
end.