untconfig.pas

非常地全面完整的物流供应链管理系统 包含全部的需求文档

unit untConfig;
{********************************************************
作者：杨中科
功能：Web层系统配置
********************************************************}

interface
uses Classes, SysUtils,MConnect, ObjBrkr, SConnect, Variants;

Const
  CONFIGKEYNAME = 'GMSAspWeb';
  APPSERVERLISTITEMNAME = 'AppServerList';

//设置应用服务器列表
procedure SetAppServerList(AValue: TStringList);
//读取应用服务器列表
procedure GetAppServerList(var AValue: TStringList);
//设置是使用应用服务器列表中的还是使用指定IP
//true是使用用服务器列表中的false则反之
procedure SetUseAppServerList(AValue: Boolean);
//读取是使用应用服务器列表中的还是使用指定IP
//true是使用用服务器列表中的false则反之
function GetUseAppServerList: Boolean;
//设置指定的IP（或局域网机器名）
procedure SetSomeIP(AValue: string);
//读取指定的IP（或局域网机器名）
function GetSomeIP: string;

//设定SocketConnection的连接形式
procedure SetDComConnectionConnect(AValue: TDComConnection);

implementation
uses CommonFunc, Registry;

procedure SetAppServerList(AValue: TStringList);
var
  LReg: TRegistry;
  LStr: string;
begin
  if AValue = nil then
    raise Exception.Create('列表未初始化!');
  LReg := TRegistry.Create;
  LReg.OpenKey('\Software\'+CONFIGKEYNAME, True);
  LStr := AValue.Text;
  LReg.WriteString(APPSERVERLISTITEMNAME, LStr);
  LReg.CloseKey;
  LReg.Free;
end;

procedure GetAppServerList(var AValue: TStringList);
var
  LReg: TRegistry;
  LStr: string;
begin
  if AValue = nil then
    raise Exception.Create('列表为初始化!');
  LReg := TRegistry.Create;
  LReg.OpenKey('\Software\'+CONFIGKEYNAME, True);
  if LReg.ValueExists(APPSERVERLISTITEMNAME) then
    LStr := LReg.ReadString (APPSERVERLISTITEMNAME)
  else
    LStr := '127.0.0.1';
  if LStr='' then
    LStr := '127.0.0.1';
  AValue.Text := LStr;
  LReg.CloseKey;
  LReg.Free;
end;

procedure SetUseAppServerList(AValue: Boolean);
var
  LReg: TRegistry;
begin
  LReg := TRegistry.Create;
  LReg.OpenKey('\Software\'+CONFIGKEYNAME, True);
  LReg.WriteBool('UseAppServer', AValue);
  LReg.CloseKey;
  LReg.Free;
end;

function GetUseAppServerList: Boolean;
var
  LReg: TRegistry;
begin
  LReg := TRegistry.Create;
  LReg.OpenKey('\Software\'+CONFIGKEYNAME, True);
  if LReg.ValueExists('UseAppServer') then
    result := LReg.ReadBool('UseAppServer')
  else
    result := false;
  LReg.CloseKey;
  LReg.Free;
end;

procedure SetSomeIP(AValue: string);
var
  LReg: TRegistry;
begin
  LReg := TRegistry.Create;
  LReg.OpenKey('\Software\'+CONFIGKEYNAME, True);
  LReg.WriteString('SomeIp', AValue);
  LReg.CloseKey;
  LReg.Free;
end;

function GetSomeIP: string;
var
  LReg: TRegistry;
begin
  LReg := TRegistry.Create;
  LReg.OpenKey('\Software\'+CONFIGKEYNAME, True);
  if LReg.ValueExists('SomeIp') then
    result := LReg.ReadString('SomeIp')
  else
    result := '127.0.0.1';
  if result = '' then
    result := '127.0.0.1';
  LReg.CloseKey;
  LReg.Free;
end;

procedure SetDComConnectionConnect(AValue: TDComConnection);
  procedure FillAppServerList(ABroker: TSimpleObjectBroker);
  var
    sl: TStringList;
    i, n: Integer;
  begin
    sl := TStringList.Create;
    GetAppServerList(sl);
    n := sl.Count - 1;
    ABroker.ServerData := null;
    for i := 0 to n do
    begin
      ABroker.Servers.Add;
      ABroker.Servers[i].ComputerName := sl.Strings[i]
    end;
    sl.Free;
  end;
var
  LBroker: TSimpleObjectBroker;
begin
  LBroker := TSimpleObjectBroker.Create(nil);
  if GetUseAppServerList then
  begin
    FillAppServerList(LBroker);
    AValue.ObjectBroker := LBroker;
    try
      AValue.Connected := true;
    except
      raise Exception.Create('应用服务器连接错误！');
    end;
  end
  else
  begin
    AValue.ComputerName := GetSomeIP;
    try
      AValue.Connected := true;
    except
      raise Exception.Create('应用服务器连接错误！');
    end;
  end;
  LBroker.Free;

end;


end.