[roamer]

Может быть пригодится :

Код:

            
function CreateStandardAlias(NrAlwaysCreate: Boolean;
                             NameAlias,
                             Path,
                             DefDrv : String) : Boolean;
//Создать Alias (Standard)                                                                    
Var
   Sess : TSession;
   SList : TStrings;
   Sx : string;
   i : integer;
   Yes : byte;
begin
   Result:=FALSE;
   Yes:=0;
   NameAlias:=Trim(NameAlias);
   Path:=Trim(Path);
   DefDrv:=Trim(DefDrv);
   if Length(DefDrv)<=0 then DefDrv:='PARADOX';
   if (Length(NameAlias)>0) and (Length(Path)>0) then begin
      Sess := TSession.Create(Nil);
      try
        Sess.SessionName:='~~!!SA!!~~';
        SList := TStringList.Create;
        try
          Sess.GetAliasNames(SList);
          i:=-1;
          while i<(SList.Count-1) do
           begin
             i:=i+1;
             Sx:=SList[i];
             Sx:=Trim(Sx);
             if Length(Sx)>0 then begin
                if AnsiUpperCase(Sx)=AnsiUpperCase(NameAlias) then begin
                   Yes:=1;
                   if NrAlwaysCreate then begin
                      Yes:=0;
                      Sess.DeleteAlias(NameAlias);
                   end;
                   i:=SList.Count+1;
                end;
             end;
          end;
        finally
          SList.Free;
        end;
        if Yes<=0 then begin
           Sess.ConfigMode := cmAll;
           Sess.AddStandardAlias(NameAlias, Path,DefDrv);
           Sess.SaveConfigFile;
           Result:=TRUE;
        end;
      finally
        Sess.Free;
      end;
   end;
end;


function CreateIBAlias(NrAlwaysCreate: Boolean;
                       NameAlias,
                       Path,
                       NameUser,
                       LangDrv : String) : Boolean;
//Создать Alias (Interbase)                                                                    
Var
   Sess : TSession;
   SList : TStrings;
   Sx : string;
   i : integer;
   Yes : byte;
begin
   Result:=FALSE;
   Yes:=0;
   NameAlias:=Trim(NameAlias);
   Path:=Trim(Path);
   NameUser:=Trim(NameUser);
   LangDrv:=Trim(LangDrv);
   if Length(LangDrv)<=0 then LangDrv:='ancyrr' {'Pdox ANSI Cyrillic'}; 
   if Length(NameUser)<=0 then NameUser:='SYSDBA';
   if (Length(NameAlias)>0) and (Length(Path)>0) then begin
      Sess := TSession.Create(Nil);
      try
        Sess.SessionName:='~~!!SA!!~~';
        SList := TStringList.Create;
        try
          Sess.GetAliasNames(SList);
          i:=-1;
          while i<(SList.Count-1) do
           begin
             i:=i+1;
             Sx:=SList[i];
             Sx:=Trim(Sx);
             if Length(Sx)>0 then begin
                if AnsiUpperCase(Sx)=AnsiUpperCase(NameAlias) then begin
                   Yes:=1;
                   if NrAlwaysCreate then begin
                      Yes:=0;
                      Sess.DeleteAlias(NameAlias);
                   end;
                   i:=SList.Count+1;
                end;
             end;
          end;
        finally
          SList.Free;
        end;
        if Yes<=0 then begin
           SList := TStringList.Create;
           try
             SList.Add('SERVER NAME='+Path);
             SList.Add('USER NAME='+NameUser);
             SList.Add('LANGDRIVER='+LangDrv);
             Sess.ConfigMode := cmAll;
             Sess.AddAlias(NameAlias, 'INTRBASE', SList);
             Sess.SaveConfigFile;
             Result:=TRUE;
           finally
             SList.Free;
           end;
        end;
      finally
        Sess.Free;
      end;
   end;
end;
    

function Alias_Update(AliasName : string;
                      ListParam : TStrings) : Boolean;
//Изменить настройку Alias                                                                              
Var
 Sess : TSession;
begin
  Result:=FALSE;
  AliasName:=Trim(AliasName);
  if Length(AliasName)>0 then begin
     if ListParam<>NIL then begin
        if ListParam.Count>0 then begin
           Sess := TSession.Create(Nil);
           try
             Sess.SessionName:='~~!!SA!!~~';
             if Sess.IsAlias(AliasName) then begin
                Sess.ConfigMode := cmAll;
                Sess.ModifyAlias(AliasName,ListParam);
                Sess.SaveConfigFile;
                Result:=TRUE;
             end;
           finally
             Sess.Free;
           end;
        end;
     end;
  end;
end;
                                               


function Alias_Delete(AliasName : string) : Boolean;
//Удалить Alias                                 
Var
 Sess : TSession;
begin
  Result:=FALSE;
  AliasName:=Trim(AliasName);
  if Length(AliasName)>0 then begin
     AliasName:=AnsiUpperCase(AliasName);
     Sess := TSession.Create(Nil);
     try
       Sess.SessionName:='~~!!SA!!~~';
       if Sess.IsAlias(AliasName) then begin
          Sess.ConfigMode := cmAll;
          Sess.DeleteAlias(AliasName);
          Sess.SaveConfigFile;
          Result:=TRUE;
       end;
     finally
       Sess.Free;
     end;
  end;
end;


function Get_ListAlias(List : TStrings) : integer;
//Список Alias                             
Var
   Sess : TSession;
begin
   Result:=0;
   if List<>NIL then begin
      List.Clear;
      Sess := TSession.Create(Nil);
      try
        Sess.SessionName:='~~77!!SA!!77~~';
        Sess.GetAliasNames(List);
        Result:=List.Count;
      finally
        Sess.Free;
      end;
   end;
end;
    

function Alias_Exist(AliasName : string) : boolean;
//Проверка существования                                                   
Var
  List : TStrings;
  i : integer;
begin
  Result:=false;
  AliasName:=AnsiUpperCase(Trim(AliasName));
  if length(AliasName)>0 then begin
     List := TStringList.Create;
     TRY
       Get_ListAlias(List);
       i:=-1;
       while i<(List.Count-1) do
        begin
         i:=i+1;
         if AliasName = AnsiUpperCase(Trim(List[i])) then begin
            Result:=true;
            i:=List.Count+1;
         end;
       end;
     FINALLY
       List_Clear(List);
     END;
  end;
end;
  
function GetInfoAboutAlias(NameAlias : String; List : TStrings) : Boolean;
//Прочитать инфу о заданном Alias                                                                        
Var
   Sess : TSession;
begin
   Result:=FALSE;
   if List<>NIL then begin
      List.Clear;
      NameAlias:=Trim(NameAlias);
      if Length(NameAlias)>0 then begin
         NameAlias:=AnsiUpperCase(NameAlias);
         Sess := TSession.Create(Nil);
         try
           Sess.SessionName:='~~99!!SA!!99~~';
           Sess.GetAliasParams(NameAlias,List);
           Result:=TRUE;
         finally
           Sess.Free;
         end;
      end;
   end;
end;